package Net::FullAuto::FA_Core;print "LINE=".__LINE__."\n";
### OPEN SOURCE LICENSE - GNU AFFERO PUBLIC LICENSE Version 3.0 #######
#
# Net::FullAuto - Powerful Network Process Automation Software
# Copyright (C) 2000-2014 Brian M. Kelly
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero 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 Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public
# License along with this program. If not, see:
# <http://www.gnu.org/licenses/agpl.html>.
#
#######################################################################
## ******* 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;print "LINE=".__LINE__."\n";
# echo "FINISHED NUM=$num"; done
#
## For re-configuring CPAN:
#
# at CPAN prompt (cpan[1]) type: o conf init
#
# at CPAN prompt: o conf urllist unshift http://www.perl.com/CPAN
#
## For creating gpg secret key for use with cpansign -s
#
# gpg --gen-key (then follow onscreen instructions)
#
# Export Public Key: http://www.gnupg.org/gph/en/manual/x56.html
# http://keyserver.ubuntu.com:11371
# http://pgp.mit.edu
# https://keyserver.pgp.com
#
# 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 -o "Setup-FullAuto-v.99999932-MSWin32-x86.exe"
# -l C:\strawberry\perl\bin\libgcc_s_sjlj-1.dll
# -l C:\strawberry\c\bin\libeay32_.dll
# -l C:\strawberry\c\bin\libz_.dll
# -l C:\strawberry\c\bin\libz.dll
# -l C:\strawberry\c\bin\ssleay32_.dll Makefile.PL
# -M Module::Build -M Task::Weaken -M YAML
# -M IO::CaptureOutput -M ExtUtils::Depends
# -M ExtUtils::MakeMaker -M B::Utils
# -M Data::Dump::Streamer -M LWP -M IO::Socket::SSL
# -M LWP::Protocol::https -M Mozilla::CA
# -M Term::RawInput -M JSON -M Term::Menus
# -M Win32::API -M Win32::DriveInfo -M DBD::SQLite
# -a bin -a ChangeLog -a inc -a Module -a lib -a t
# -a META.yml -a LICENSE -a MANIFEST -a README
# -a UNINSTALL_CYGWIN --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.
#
## Cygwin sshd - /bin/bash: Operation not permitted.
#
# Culprit is mostly permissions on /var/empty and /var/run
# chown cyg_server /var/empty
# chmod 755 /var/empty
# see cygwin_sshd.pdf (in FullAuto distribution) and at
# http://http://www.tux.org/~mayer/cygwin/cygwin_sshd.pdf
#
## ASCII BANNER Courtesy of (small font):
#
# http://www.network-science.de/ascii/
#
## TO DO: Look for way to fix this error:
#
# cd "/cygdrive_funkyPrompt_cd "/cygdrive/c/Users/KB06606-admin" 2>&1
#
## *************************************************************
use strict;print "LINE=".__LINE__."\n";
use warnings;print "LINE=".__LINE__."\n";
###################################
our $cygwin_berkeley_db_mode = 777;print "LINE=".__LINE__."\n";
###################################
our $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
our @tran=('','',0,$$."_".$^T,'',0);print "LINE=".__LINE__."\n";
$ENV{OS}='' if !$ENV{OS};print "LINE=".__LINE__."\n";
my $md_='';our $thismonth='';our $thisyear='';print "LINE=".__LINE__."\n";
($md_,$thismonth,$thisyear)=(localtime)[3,4,5];print "LINE=".__LINE__."\n";
my $mo_=$thismonth;my $yr_=$thisyear;print "LINE=".__LINE__."\n";
$md_="0$md_" if $md_<10;print "LINE=".__LINE__."\n";
$mo_++;$mo_="0$mo_" if $mo_<10;print "LINE=".__LINE__."\n";
my $yr__=sprintf("%02d",$yr_%100);print "LINE=".__LINE__."\n";
my $yr____=(1900+$yr_);print "LINE=".__LINE__."\n";
my $mdy="$mo_$md_$yr__";print "LINE=".__LINE__."\n";
my $mdyyyy="$mo_$md_$yr____";print "LINE=".__LINE__."\n";
my $tm=scalar localtime($^T);print "LINE=".__LINE__."\n";
my $hms=substr($tm,11,8);print "LINE=".__LINE__."\n";
$hms=~s/^(\d\d):(\d\d):(\d\d)$/h${1}m${2}s${3}/;print "LINE=".__LINE__."\n";
my $hr=$1;my $mn=$2;my $sc=$3;print "LINE=".__LINE__."\n";
our $curyear=$thisyear + 1900;print "LINE=".__LINE__."\n";
our $curcen=unpack('a2',$curyear);print "LINE=".__LINE__."\n";
our @invoked=($^T, $tm, $mdy, $hms, $hr, $mn, $sc, $mdyyyy);print "LINE=".__LINE__."\n";
BEGIN {
$main::netfull='';print "LINE=".__LINE__."\n";
unless (exists $INC{'Net/FullAuto.pm'}) {
foreach my $fpath (@INC) {
my $f=$fpath;print "LINE=".__LINE__."\n";
if (-e $f.'/Net/FullAuto.pm') {
$main::netfull=$f.'/Net/FullAuto.pm';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
} else {
$main::netfull=$INC{'Net/FullAuto.pm'};print "LINE=".__LINE__."\n";
}
}
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";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
#use if ($^O eq 'cygwin'), 'Win32::Semaphore';print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin' && $0 ne 'test.t') {
my $srvout=`/bin/cygrunsrv -Q cygserver 2>&1`;print "LINE=".__LINE__."\n";
if (-1<index $srvout,'Stopped') {
print "\n FATAL ERROR! - The Cygwin cygserver service is NOT",
" running:\n\n ${srvout}To start type: ".
"'net start cygserver'\n\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
} elsif (-1<index $srvout,'The specified service does not exist') {
print "\n FATAL ERROR! - The Cygwin cygserver service is NOT",
" installed:\n\n ${srvout}To install type: ",
"'/bin/cygserver-config'\n\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
$srvout=`/bin/cygrunsrv -Q sshd 2>&1`;print "LINE=".__LINE__."\n";
if (-1<index $srvout,'Stopped') {
my $ps=`/bin/ps -e`;print "LINE=".__LINE__."\n";
if (-1<index $ps,'sshd') {
foreach my $line (split "\n", $ps) {
my $pid=$line;print "LINE=".__LINE__."\n";
next unless -1<index $line,'sshd';print "LINE=".__LINE__."\n";
$pid=~s/^\s(\d+)\s+.*$/$1/;print "LINE=".__LINE__."\n";
`/bin/kill -f $pid`;print "LINE=".__LINE__."\n";
}
my $output=`net start sshd 2>&1`;
unless (-1<index $output,'CYGWIN sshd service was started') {
print "\n FATAL ERROR! - The Cygwin sshd (Secure Shell) ",
"service is NOT running:\n\n ${srvout}To start type: ",
"'net start sshd'\n\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
} else {
print "\n FATAL ERROR! - The Cygwin sshd (Secure Shell) ",
"service is NOT running:\n\n ${srvout}To start type: ",
"'net start sshd'\n\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
} elsif (-1<index $srvout,'The specified service does not exist') {
print "\n FATAL ERROR! - The Cygwin sshd (Secure Shell) ",
"service is NOT installed:\n\n ${srvout}To install type: ",
"'/bin/ssh-host-config --privileged'\n\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
my $srvaccount=`sc qc sshd`;print "LINE=".__LINE__."\n";
$srvaccount=~s/^.*SERVICE_START_NAME : (?:.\\)*(.*?)\s*$/$1/s;print "LINE=".__LINE__."\n";
my $rights=`/bin/editrights -u $srvaccount -l 2>&1`;print "LINE=".__LINE__."\n";
if ($rights!~/^Error/) {
if ((-1<index $rights,'SeDenyRemoteInteractiveLogonRight') ||
(-1==index $rights,'SeServiceLogonRight') ||
(-1==index $rights,'SeTcbPrivilege') ||
(-1==index $rights,'SeCreateTokenPrivilege') ||
(-1==index $rights,'SeAssignPrimaryTokenPrivilege') || 1) {
my @missing_rights=();print "LINE=".__LINE__."\n";
my $output='';my $restart_sshd=0;print "LINE=".__LINE__."\n";
if (-1<index $rights,'SeDenyRemoteInteractiveLogonRight') {
my $rt='SeDenyRemoteInteractiveLogonRight';print "LINE=".__LINE__."\n";
$output=`/bin/editrights -r $rt -u $srvaccount 2>&1`;print "LINE=".__LINE__."\n";
if ($output=~/^Error/) {
my $die="\n ".
"FATAL ERROR! - The following restriction was\n ".
" discovered for the sshd service\n ".
" account '".$srvaccount."':\n\n".
$rt."\n\n An attempt was made to remove this,\n".
" but was not successful:\n\n $output\n\n".
" Please contact your Domain and/or System".
" Administrators for assistance.\n\n";print "LINE=".__LINE__."\n";
print $die;print "LINE=".__LINE__."\n";
exit 1;print "LINE=".__LINE__."\n";
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeTcbPrivilege') {
$output=`/bin/editrights -a SeTcbPrivilege -u $srvaccount 2>&1`;print "LINE=".__LINE__."\n";
if ($output=~/^Error/) {
push @missing_rights, 'SeTcbPrivilege';print "LINE=".__LINE__."\n";
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeCreateTokenPrivilege') {
my $prv='SeCreateTokenPrivilege';print "LINE=".__LINE__."\n";
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;print "LINE=".__LINE__."\n";
if ($output=~/^Error/) {
push @missing_rights, 'SeCreateTokenPrivilege';print "LINE=".__LINE__."\n";
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeAssignPrimaryTokenPrivilege') {
my $prv='SeAssignPrimaryTokenPrivilege';print "LINE=".__LINE__."\n";
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;print "LINE=".__LINE__."\n";
if ($output=~/^Error/) {
push @missing_rights, 'SeAssignPrimaryTokenPrivilege';print "LINE=".__LINE__."\n";
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeServiceLogonRight') {
my $prv='SeServiceLogonRight';print "LINE=".__LINE__."\n";
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;print "LINE=".__LINE__."\n";
if ($output=~/^Error/) {
push @missing_rights, 'SeServiceLogonRight';print "LINE=".__LINE__."\n";
} else { $restart_sshd=1 }
}
if (-1<$#missing_rights) {
my $mis=join "\n",map { " $_" } @missing_rights;print "LINE=".__LINE__."\n";
my $die="\n FATAL ERROR! - The following priviliges are\n ".
" missing from the ID '".$srvaccount."':\n\n".
$mis."\n\n An attempt was made to add these priviliges,".
"\n but was not successful. Please contact your\n".
" your Domain and/or System Administrators for\n".
" assistance. These priviliges can be controlled at\n".
" the domain level with a global policy that\n".
" affects one or multiple hosts. These policies\n".
" are enforced at host startup - which would\n".
" explain why sshd may have worked in an earlier\n".
" session, or immediately following installation,\n".
" but not after a reboot.\n\n";print "LINE=".__LINE__."\n";
print $die;print "LINE=".__LINE__."\n";
exit 1;print "LINE=".__LINE__."\n";
} elsif ($restart_sshd) {
$srvout=`/bin/cygrunsrv -Q sshd 2>&1`;print "LINE=".__LINE__."\n";
my $output=`net stop sshd 2>&1`;print "LINE=".__LINE__."\n";
unless (-1<index $output,'CYGWIN sshd service was stopped') {
print "\n FATAL ERROR! - ".
" The Cygwin sshd (Secure Shell) service ",
" could NOT be restarted:\n\n${srvout}".
"Error: $output\n\nTo restart, Run as Administrator\n".
"\nand type: 'net stop sshd'\n".
"and then: 'net start sshd'\n\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
$output=`net start sshd 2>&1`;print "LINE=".__LINE__."\n";
unless (-1<index $output,'CYGWIN sshd service was started') {
print "\n FATAL ERROR! - ".
" The Cygwin sshd (Secure Shell) service ",
" could NOT be started:\n\n${srvout}".
"Error: $output\n\nTo restart, Run as Administrator\n".
"\nand then: 'net start sshd'\n\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
}
}
}
}
use IPC::Semaphore;print "LINE=".__LINE__."\n";
use IPC::SysV qw(IPC_CREAT SEM_UNDO S_IRWXU);print "LINE=".__LINE__."\n";
push @INC, substr($main::netfull,0,-3);print "LINE=".__LINE__."\n";
}
use warnings;print "LINE=".__LINE__."\n";
{
no warnings;print "LINE=".__LINE__."\n";
use Socket;print "LINE=".__LINE__."\n";
require Exporter;print "LINE=".__LINE__."\n";
}
our @ISA = qw(Exporter Net::Telnet Cwd);print "LINE=".__LINE__."\n";
our @EXPORT = qw(%Hosts $localhost getpasswd
connect_host get_all_hosts
$username connect_ftp $cron
connect_telnet connect_sftp
connect_mozrepl $passwd_file_loc
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_parse
cleanup $dest_first_hash %days
test_file test_dir timelocal
%GLOBAL @GLOBAL $MRLOG $fullauto
$funkyprompt handle_error
$quiet $batch $unattended
%email_addresses @plans $adminmenu
%email_defaults $service
persist_get persist_put cache
$berkeleydb %admin_menus $^O
$cache_root $cache_key $admin_menu
acquire_fa_lock release_fa_lock
$choose_pass_expiration
%monthconv %mimetypes username);print "LINE=".__LINE__."\n";
{
no warnings;print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use Sys::Hostname;print "LINE=".__LINE__."\n";
our $local_hostname=&Sys::Hostname::hostname;print "LINE=".__LINE__."\n";
use Data::Dump::Streamer;print "LINE=".__LINE__."\n";
use Time::Local;print "LINE=".__LINE__."\n";
use Crypt::CBC;print "LINE=".__LINE__."\n";
use Crypt::DES;print "LINE=".__LINE__."\n";
use Cwd qw(getcwd);print "LINE=".__LINE__."\n";
use Digest::MD5 qw(md5);print "LINE=".__LINE__."\n";
use Digest::SHA qw(sha256_hex);print "LINE=".__LINE__."\n";
use English;print "LINE=".__LINE__."\n";
use Email::Sender::Simple qw(sendmail);print "LINE=".__LINE__."\n";
use Email::Sender::Transport::SMTP qw();print "LINE=".__LINE__."\n";
use Errno qw(EAGAIN EINTR EWOULDBLOCK);print "LINE=".__LINE__."\n";
use File::stat;print "LINE=".__LINE__."\n";
use File::Copy;print "LINE=".__LINE__."\n";
use MIME::Entity;print "LINE=".__LINE__."\n";
use Module::Load::Conditional qw[can_load];print "LINE=".__LINE__."\n";
use Net::Telnet;print "LINE=".__LINE__."\n";
use Getopt::Long;print "LINE=".__LINE__."\n";
use Pod::Usage;print "LINE=".__LINE__."\n";
use Term::ReadKey;print "LINE=".__LINE__."\n";
use Term::RawInput;print "LINE=".__LINE__."\n";
use LWP::UserAgent ();print "LINE=".__LINE__."\n";
use LWP::MediaTypes qw(guess_media_type media_suffix);print "LINE=".__LINE__."\n";
use URI ();print "LINE=".__LINE__."\n";
use HTTP::Date ();print "LINE=".__LINE__."\n";
use IO::Handle;print "LINE=".__LINE__."\n";
use IO::Select;print "LINE=".__LINE__."\n";
use IO::Capture::Stderr;print "LINE=".__LINE__."\n";
use IO::CaptureOutput;print "LINE=".__LINE__."\n";
use Capture::Tiny;print "LINE=".__LINE__."\n";
use String::Random;print "LINE=".__LINE__."\n";
use Symbol qw(qualify_to_ref);print "LINE=".__LINE__."\n";
use Tie::Cache;print "LINE=".__LINE__."\n";
use IO::Pty;print "LINE=".__LINE__."\n";
use POSIX qw(setsid uname);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
our $home_dir='~';print "LINE=".__LINE__."\n";
if (exists $ENV{HOME} && -d $ENV{HOME}) {
$home_dir=$ENV{HOME};print "LINE=".__LINE__."\n";
} elsif (exists $ENV{USER} && $ENV{USER}) {
if (-d "/home/$ENV{USER}") {
$home_dir="/home/$ENV{USER}";print "LINE=".__LINE__."\n";
} elsif (-d "/export/home/$ENV{USER}") {
$home_dir="/export/home/$ENV{USER}";print "LINE=".__LINE__."\n";
}
} elsif ((getpwuid($<))[7]) {
$home_dir=(getpwuid($<))[7];print "LINE=".__LINE__."\n";
}
BEGIN {
my $md_='';our $thismonth='';our $thisyear='';print "LINE=".__LINE__."\n";
($md_,$thismonth,$thisyear)=(localtime)[3,4,5];print "LINE=".__LINE__."\n";
my $mo_=$thismonth;my $yr_=$thisyear;print "LINE=".__LINE__."\n";
$md_="0$md_" if $md_<10;print "LINE=".__LINE__."\n";
$mo_++;$mo_="0$mo_" if $mo_<10;print "LINE=".__LINE__."\n";
my $yr__=sprintf("%02d",$yr_%100);print "LINE=".__LINE__."\n";
my $yr____=(1900+$yr_);print "LINE=".__LINE__."\n";
my $mdy="$mo_$md_$yr__";print "LINE=".__LINE__."\n";
my $mdyyyy="$mo_$md_$yr____";print "LINE=".__LINE__."\n";
my $tm=scalar localtime($^T);print "LINE=".__LINE__."\n";
my $hms=substr($tm,11,8);print "LINE=".__LINE__."\n";
$hms=~s/^(\d\d):(\d\d):(\d\d)$/h${1}m${2}s${3}/;print "LINE=".__LINE__."\n";
my $hr=$1;my $mn=$2;my $sc=$3;print "LINE=".__LINE__."\n";
our $curyear=$thisyear + 1900;print "LINE=".__LINE__."\n";
our $curcen=unpack('a2',$curyear);print "LINE=".__LINE__."\n";
our @invoked=($^T, $tm, $mdy, $hms, $hr, $mn, $sc, $mdyyyy);print "LINE=".__LINE__."\n";
my $customdir='Net/FullAuto/Custom';print "LINE=".__LINE__."\n";
our $fa_conf='';print "LINE=".__LINE__."\n";
if (defined $Term::Menus::fa_conf) {
$fa_conf=$Term::Menus::fa_conf;print "LINE=".__LINE__."\n";
if (defined $fa_conf->[0]) {
eval {
require $fa_conf->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fa_conf=$mod.'.pm';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
}
}
our $fa_host='';print "LINE=".__LINE__."\n";
if (defined $Term::Menus::fa_host) {
$fa_host=$Term::Menus::fa_host;print "LINE=".__LINE__."\n";
if (defined $fa_host->[0]) {
eval {
require $fa_host->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_host->[0],(rindex $fa_host->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fa_host=$mod.'.pm';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
}
}
our $fa_maps='';print "LINE=".__LINE__."\n";
if (defined $Term::Menus::fa_maps) {
$fa_maps=$Term::Menus::fa_maps;print "LINE=".__LINE__."\n";
if (defined $fa_maps->[0]) {
eval {
require $fa_maps->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_maps->[0],(rindex $fa_maps->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fa_maps=$mod.'.pm';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
}
}
our $fa_menu='';print "LINE=".__LINE__."\n";
if (defined $Term::Menus::fa_menu) {
$fa_menu=$Term::Menus::fa_menu;print "LINE=".__LINE__."\n";
if (defined $fa_menu->[0]) {
eval {
require $fa_menu->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_menu->[0],(rindex $fa_menu->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fa_menu=$mod.'.pm';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
}
}
our $sftpport='';print "LINE=".__LINE__."\n";
sub sftport {
$Net::FullAuto::FA_Core::sftpport='';print "LINE=".__LINE__."\n";
my $sftppath=$_[0];print "LINE=".__LINE__."\n";
my $sftport=`${sftppath}sftp 2>&1`;print "LINE=".__LINE__."\n";
if ($sftport) {
if ($sftport=~/-P sftp_server_path/s) {
$sftport='-oPort=';print "LINE=".__LINE__."\n";
} else {
$sftport='-P ';print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::sftpport=$sftport;print "LINE=".__LINE__."\n";
}
}
my $win2unix=sub {
my $slash=$_[0];print "LINE=".__LINE__."\n";
$slash=~s/\\/\//g;print "LINE=".__LINE__."\n";
return $slash;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
our $gbp=sub { # Get Bin Path
my $cmd=$_[0];print "LINE=".__LINE__."\n";
my $handle=$_[1];print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cmdinfo={}
unless $Net::FullAuto::FA_Core::cmdinfo;print "LINE=".__LINE__."\n";
my $object=($handle)?$handle:$Net::FullAuto::FA_Core::cmdinfo;print "LINE=".__LINE__."\n";
unless (exists $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}) {
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
if ($handle) {
unless (exists $handle->{_shell}) {
($stdout,$stderr)=$handle->cmd('env');print "LINE=".__LINE__."\n";
if ($stdout=~/^SHELL=(.*)$/m) {
my $shell=$1;chomp $shell;print "LINE=".__LINE__."\n";
$handle->{_shell}=$shell;print "LINE=".__LINE__."\n";
}
}
if ((-1<index $handle->{_shell}, 'bash') ||
(-1<index $handle->{_shell}, 'ksh')) {
($stdout,$stderr)=$handle->cmd(
"if [ -f /bin/$cmd ];then echo \"FOUND\";fi");print "LINE=".__LINE__."\n";
print "STDOUT=$stdout<==\n";print "LINE=".__LINE__."\n";
if (-1<index $stdout,'FOUND') {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/bin/";print "LINE=".__LINE__."\n";
return "/bin/";print "LINE=".__LINE__."\n";
}
}
} elsif (-e "/usr/bin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/usr/bin/";print "LINE=".__LINE__."\n";
sftport("/usr/bin/") if $cmd eq 'sftp';
return "/usr/bin/";print "LINE=".__LINE__."\n";
} elsif (-e "/bin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/bin/";print "LINE=".__LINE__."\n";
sftport("/bin/") if $cmd eq 'sftp';print "LINE=".__LINE__."\n";
return "/bin/";print "LINE=".__LINE__."\n";
} elsif (-e "/usr/local/bin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/usr/local/bin/";print "LINE=".__LINE__."\n";
sftport("/usr/local/bin/") if $cmd eq 'sftp';print "LINE=".__LINE__."\n";
return "/usr/local/bin/";print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' && (exists $ENV{'WINDIR'}) &&
((-e $win2unix->($ENV{'WINDIR'}).'/system32/'.$cmd)
|| (-e $win2unix->($ENV{'WINDIR'}).'/system32/'.$cmd.'.exe'))) {
if (-e $win2unix->($ENV{'WINDIR'}).'/system32/'.$cmd) {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
$win2unix->($ENV{'WINDIR'})."/system32/$cmd";print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
$win2unix->($ENV{'WINDIR'})."/system32/${cmd}.exe";print "LINE=".__LINE__."\n";
}
sftport("$win2unix->($ENV{'WINDIR'}).'/system32/'")
if $cmd eq 'sftp';print "LINE=".__LINE__."\n";
return $win2unix->($ENV{'WINDIR'}).'/system32/';print "LINE=".__LINE__."\n";
} elsif (-e "/etc/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/etc/";print "LINE=".__LINE__."\n";
sftport("/etc/") if $cmd eq 'sftp';print "LINE=".__LINE__."\n";
return "/etc/";print "LINE=".__LINE__."\n";
} elsif (-e "/usr/sbin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/usr/sbin/";print "LINE=".__LINE__."\n";
sftport("/usr/sbin/") if $cmd eq 'sftp';print "LINE=".__LINE__."\n";
return "/usr/sbin/";print "LINE=".__LINE__."\n";
} elsif (-e "/sbin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/sbin/";print "LINE=".__LINE__."\n";
sftport("/sbin/") if $cmd eq 'sftp';print "LINE=".__LINE__."\n";
return "/sbin/";print "LINE=".__LINE__."\n";
}
} else {
return $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd};print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
our $termwidth=''; our $termheight='';print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug) {
eval {
no strict 'subs';print "LINE=".__LINE__."\n";
($termwidth, $termheight) = GetTerminalSize(STDOUT);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
$termwidth='';$termheight='';print "LINE=".__LINE__."\n";
}
}
our %admin_menus=(
'define_module_from_viewdef' => '',
'defaultsettings' => '',
'viewdefaults' => '',
'cacode' => '',
'cahost' => '',
'caconf' => '',
'camaps' => '',
'camenu' => '',
'cacomm' => '',
'admin' => '',
'plan' => '',
'define_modules_commit' => '',
'define_modules_menu_fa_menu' => '',
'define_modules_menu_fa_maps' => '',
'define_modules_menu_fa_host' => '',
'define_modules_menu_fa_conf' => '',
'define_modules_menu_fa_code' => '',
'delete_sets_menu' => '',
'im_ex_menu' => '',
'im_from_remote' => '',
'login_to_remote' => '',
'manage_modules_menu' => '',
'remote_fa_users' => '',
'select_component_dir' => '',
'select_comp_to_import' => '',
'select_how_to_insert' => '',
'select_user_comp_file' => '',
'set_default_menu' => '',
'set_default_menu_in_db_sub' => '',
'set_menu' => '',
);print "LINE=".__LINE__."\n";
our $locks = {
1234 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable => 1,
Lock_Description =>
'DEFAULT Lock - used when a unique'.
" key is not supplied.\n ".
'Used internally mostly to protect'.
' short duration input I/O.',
Wait_For_NewLock => 60,
PollingMilliSecs => 1000,
},
7755 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable => 1,
Lock_Description =>
'clean_filehandle() Lock - '.
"used to prevent more than\n ".
'one FullAuto instance using'.
' this routine at a time.',
Wait_For_NewLock => 60,
PollingMilliSecs => 500,
},
9361 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable => 1,
Lock_Description =>
'getpasswd() Lock - '.
'used to protect password'.
' retrieval.',
Wait_For_NewLock => 60,
PollingMilliSecs => 500,
},
9854 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable => 1,
Lock_Description =>
'Password Input Lock',
Wait_For_NewLock => 60,
PollingMilliSecs => 500,
},
9876 => {
MaxNumberAllowed => 2,
KillAfterSeconds => 300,
Enable => 1,
Lock_Description =>
'FullAuto Capacity '.
'Lock - dictates the '.
"maximum\n number of FullAuto".
' invocations running in '.
'parallel.',
Wait_For_NewLock => 60,
PollingMilliSecs => 500,
},
6543 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable => 1,
Lock_Description =>
'Local Host Login Lock',
Wait_For_NewLock => 60,
PollingMilliSecs => 500,
},
8712 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable_This_Lock => 1,
Lock_Description =>
'/bin/mount Lock',
Wait_For_NewLock => 60,
PollingMilliSecs => 500,
},
};print "LINE=".__LINE__."\n";
use Fcntl qw(S_IMODE);print "LINE=".__LINE__."\n";
our $fa_perm=S_IMODE((CORE::stat($main::netfull))[2]);print "LINE=".__LINE__."\n";
}
# 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,$cat,
$default,$facode,$faconf,$fahost,$famaps,$famenu,$passwrd,
$users,$usrname,$import,$export,$VERSION,%GLOBAL,@GLOBAL,
$identityfile,$tutorial);print "LINE=".__LINE__."\n";
# Globally Scoped and Intialized Variables.
our $blanklines='';our $oldpasswd='';our $authorize_connect='';print "LINE=".__LINE__."\n";
our $scrub=0;our $pcnt=0;our $chk_id='';our $d_sub='';print "LINE=".__LINE__."\n";
our $deploy_info='';our $f_sub='';our $updatepw=0;print "LINE=".__LINE__."\n";
our $shown='';our $websphere_not_running=0;my @hours=();print "LINE=".__LINE__."\n";
our $master_hostlabel='';our $random=0;our @plans=();print "LINE=".__LINE__."\n";
our $parent_menu='';our @menu_args=();our $savetran=0;print "LINE=".__LINE__."\n";
our $MRLOG='';our @pid_ts=();our %drives=();our @month=();print "LINE=".__LINE__."\n";
our $username='';our @passwd=('','');our %cygpathw=();print "LINE=".__LINE__."\n";
our $localhost={};our %localhost=();our %cygpathu=();print "LINE=".__LINE__."\n";
our @RCM_Link=();our @FTM_Link=();our $cleanup=0;our %Maps=();print "LINE=".__LINE__."\n";
our $starting_memory=0;our $custom_code_module_file='';print "LINE=".__LINE__."\n";
our %email_addresses=();our $debug=0;our %tiedb=();print "LINE=".__LINE__."\n";
our @ascii_que=();our $passetts=['','','','','','','','','',''];print "LINE=".__LINE__."\n";
our %Connections=();our $tranback=0;our @ascii=();our $uhray='';print "LINE=".__LINE__."\n";
our %base_excluded_dirs=();our %base_excluded_files=();
our %hours=();our %Hosts=();our $berkeleydb='';print "LINE=".__LINE__."\n";
our %same_host_as_Master=("__Master_${$}__"=>'-','localhost'=>'-');print "LINE=".__LINE__."\n";
our @same_host_as_Master=();our $dest_first_hash='';print "LINE=".__LINE__."\n";
our %file_rename=();our %rename_file=();our $quiet='';print "LINE=".__LINE__."\n";
our %filerename=();our %renamefile=();our %fullmonth=();print "LINE=".__LINE__."\n";
our %Processes=();our %shellpids=();our %ftpcwd=();our $newuser='';print "LINE=".__LINE__."\n";
our @DeploySMB_Proxy=('');our @DeployRCM_Proxy=('');print "LINE=".__LINE__."\n";
our @DeployFTM_Proxy=('');our $master_transfer_dir='';print "LINE=".__LINE__."\n";
our %perms=();our @ApacheNode=();our $test=0;our %days=();print "LINE=".__LINE__."\n";
our $prod=0;our $force_pause_for_exceed=0;our $tosspass=0;print "LINE=".__LINE__."\n";
our $timeout=60;our $cltimeout='X';our $slave=0;our $dcipher='';print "LINE=".__LINE__."\n";
our %email_defaults=();our $increment=0;our %tosspass=();print "LINE=".__LINE__."\n";
our $email_defaults='';our %semaphores=();our $batch='';print "LINE=".__LINE__."\n";
our $unattended='';our %month=();our $fullauto='';our $service='';print "LINE=".__LINE__."\n";
our @dhostlabels=();our %monthconv=();our $cache_root='';print "LINE=".__LINE__."\n";
our $cache_key='';our $admin='';our $menu='';our $welcome='';print "LINE=".__LINE__."\n";
our %hourconv=();our @weekdays=();our %weekdaysconv=();print "LINE=".__LINE__."\n";
our %mimetypes=();our $identity_file='';our $skip_host_hash='';print "LINE=".__LINE__."\n";
our $funkyprompt='\\\\137\\\\146\\\\165\\\\156\\\\153\\\\171\\\\120'.
'\\\\162\\\\157\\\\155\\\\160\\\\164\\\\137';print "LINE=".__LINE__."\n";
our $specialperms='none';print "LINE=".__LINE__."\n";
{
my $ex=$0;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
$ex=~s/\.pl$/\.exe/;print "LINE=".__LINE__."\n";
} else {
$ex=~s/\.pl$//;print "LINE=".__LINE__."\n";
}
if (-u $ex) {
umask(077);print "LINE=".__LINE__."\n";
$specialperms='setuid';print "LINE=".__LINE__."\n";
} elsif (-g $ex) {
umask(007);print "LINE=".__LINE__."\n";
$specialperms='setgid';print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
%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');print "LINE=".__LINE__."\n";
@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');print "LINE=".__LINE__."\n";
%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);print "LINE=".__LINE__."\n";
@weekdays=('Sunday ','Monday ','Tuesday ','Wednesday',
'Thursday ','Friday ','Saturday ');print "LINE=".__LINE__."\n";
%weekdaysconv=('Sunday'=>1,'Monday'=>2,'Tuesday'=>3,
'Wednesday'=>4,'Thursday'=>5,'Friday'=>6,
'Saturday'=>7);print "LINE=".__LINE__."\n";
%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');print "LINE=".__LINE__."\n";
@month=('January ','February ','March ',
'April ','May ','June ','July ',
'August ','September','October ','November ',
'December ');print "LINE=".__LINE__."\n";
%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);print "LINE=".__LINE__."\n";
%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');print "LINE=".__LINE__."\n";
%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','0'=>'Sunday',
'1'=>'Monday','2'=>'Tuesday','3'=>'Wednesday',
'4'=>'Thursday','5'=>'Friday','6'=>'Saturday');print "LINE=".__LINE__."\n";
%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');print "LINE=".__LINE__."\n";
@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']);print "LINE=".__LINE__."\n";
#['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']);print "LINE=".__LINE__."\n";
%mimetypes=(
'3dm' => 'x-world/x-3dmf',
'3dmf' => 'x-world/x-3dmf',
a => 'application/octet-stream',
aab => 'application/x-authorware-bin',
aam => 'application/x-authorware-map',
aas => 'application/x-authorware-seg',
abc => 'text/vnd.abc',
acgi => 'text/html',
afl => 'video/animaflex',
ai => 'application/postscript',
aif => 'audio/aiff',
#aif => 'audio/x-aiff',
aifc => 'audio/aiff',
#aifc => 'audio/x-aiff',
aiff => 'audio/aiff',
#aiff => 'audio/x-aiff',
aim => 'application/x-aim',
aip => 'text/x-audiosoft-intra',
ani => 'application/x-navi-animation',
aos => 'application/x-nokia-9000-communicator-add-on-software',
aps => 'application/mime',
arc => 'application/octet-stream',
arj => 'application/arj',
#arj => 'application/octet-stream',
art => 'image/x-jg',
asf => 'video/x-ms-asf',
asm => 'text/x-asm',
asp => 'text/asp',
asx => 'application/x-mplayer2',
#asx => 'video/x-ms-asf',
#asx => 'video/x-ms-asf-plugin',
au => 'audio/basic',
#au => 'audio/x-au',
#avi => 'application/x-troff-msvideo',
avi => 'video/avi',
#avi => 'video/msvideo',
#avi => 'video/x-msvideo',
avs => 'video/avs-video',
bcpio => 'application/x-bcpio',
#bin => 'application/mac-binary',
#bin => 'application/macbinary',
bin => 'application/octet-stream',
#bin => 'application/x-binary',
#bin => 'application/x-macbinary',
bm => 'image/bmp',
bmp => 'image/bmp',
#bmp => 'image/x-windows-bmp',
boo => 'application/book',
book => 'application/book',
boz => 'application/x-bzip2',
bsh => 'application/x-bsh',
bz => 'application/x-bzip',
bz2 => 'application/x-bzip2',
c => 'text/plain',
#c => 'text/x-c',
'c++' => 'text/plain',
cat => 'application/vnd.ms-pki.seccat',
cc => 'text/plain',
#cc => 'text/x-c',
ccad => 'application/clariscad',
cco => 'application/x-cocoa',
cdf => 'application/cdf',
#cdf => 'application/x-cdf',
#cdf => 'application/x-netcdf',
cer => 'application/pkix-cert',
#cer => 'application/x-x509-ca-cert',
cha => 'application/x-chat',
chat => 'application/x-chat',
class => 'application/java',
#class => 'application/java-byte-code',
#class => 'application/x-java-class',
com => 'application/octet-stream',
#com => 'text/plain',
conf => 'text/plain',
cpio => 'application/x-cpio',
cpp => 'text/x-c',
cpt => 'application/mac-compactpro',
#cpt => 'application/x-compactpro',
#cpt => 'application/x-cpt',
crl => 'application/pkcs-crl',
#crl => 'application/pkix-crl',
crt => 'application/pkix-cert',
#crt => 'application/x-x509-ca-cert',
#crt => 'application/x-x509-user-cert',
#csh => 'application/x-csh',
csh => 'text/x-script.csh',
#css => 'application/x-pointplus',
css => 'text/css',
cxx => 'text/plain',
dcr => 'application/x-director',
deepv => 'application/x-deepv',
def => 'text/plain',
der => 'application/x-x509-ca-cert',
dif => 'video/x-dv',
dir => 'application/x-director',
dl => 'video/dl',
#dl => 'video/x-dl',
doc => 'application/msword',
dot => 'application/msword',
dp => 'application/commonground',
drw => 'application/drafting',
dump => 'application/octet-stream',
dv => 'video/x-dv',
dvi => 'application/x-dvi',
#dwf => 'drawing/x-dwf => '(old)',
dwf => 'model/vnd.dwf',
#dwg => 'application/acad',
dwg => 'image/vnd.dwg',
#dwg => 'image/x-dwg',
#dxf => 'application/dxf',
dxf => 'image/vnd.dwg',
#dxf => 'image/x-dwg',
dxr => 'application/x-director',
el => 'text/x-script.elisp',
#elc => 'application/x-bytecode.elisp => '(compiled => 'elisp)',
elc => 'application/x-elc',
env => 'application/x-envoy',
eps => 'application/postscript',
es => 'application/x-esrehber',
etx => 'text/x-setext',
evy => 'application/envoy',
#evy => 'application/x-envoy',
exe => 'application/octet-stream',
f => 'text/plain',
f => 'text/x-fortran',
f77 => 'text/x-fortran',
f90 => 'text/plain',
#f90 => 'text/x-fortran',
fdf => 'application/vnd.fdf',
#fif => 'application/fractals',
fif => 'image/fif',
fli => 'video/fli',
#fli => 'video/x-fli',
flo => 'image/florian',
flx => 'text/vnd.fmi.flexstor',
fmf => 'video/x-atomic3d-feature',
for => 'text/plain',
#for => 'text/x-fortran',
fpx => 'image/vnd.fpx',
#fpx => 'image/vnd.net-fpx',
frl => 'application/freeloader',
funk => 'audio/make',
g => 'text/plain',
g3 => 'image/g3fax',
gif => 'image/gif',
gl => 'video/gl',
#gl => 'video/x-gl',
gsd => 'audio/x-gsm',
gsm => 'audio/x-gsm',
gsp => 'application/x-gsp',
gss => 'application/x-gss',
gtar => 'application/x-gtar',
gz => 'application/x-compressed',
gz => 'application/x-gzip',
gzip => 'application/x-gzip',
#gzip => 'multipart/x-gzip',
h => 'text/plain',
#h => 'text/x-h',
hdf => 'application/x-hdf',
help => 'application/x-helpfile',
hgl => 'application/vnd.hp-hpgl',
hh => 'text/plain',
#hh => 'text/x-h',
hlb => 'text/x-script',
hlp => 'application/hlp',
#hlp => 'application/x-helpfile',
#hlp => 'application/x-winhelp',
hpg => 'application/vnd.hp-hpgl',
hpgl => 'application/vnd.hp-hpgl',
hqx => 'application/binhex',
#hqx => 'application/binhex4',
#hqx => 'application/mac-binhex',
#hqx => 'application/mac-binhex40',
#hqx => 'application/x-binhex40',
#hqx => 'application/x-mac-binhex40',
hta => 'application/hta',
htc => 'text/x-component',
htm => 'text/html',
html => 'text/html',
htmls => 'text/html',
htt => 'text/webviewhtml',
htx => 'text/html',
ice => 'x-conference/x-cooltalk',
ico => 'image/x-icon',
idc => 'text/plain',
ief => 'image/ief',
iefs => 'image/ief',
iges => 'application/iges',
#iges => 'model/iges',
igs => 'application/iges',
#igs => 'model/iges',
ima => 'application/x-ima',
imap => 'application/x-httpd-imap',
inf => 'application/inf',
ins => 'application/x-internett-signup',
ip => 'application/x-ip2',
isu => 'video/x-isvideo',
it => 'audio/it',
iv => 'application/x-inventor',
ivr => 'i-world/i-vrml',
ivy => 'application/x-livescreen',
jam => 'audio/x-jam',
jav => 'text/plain',
#jav => 'text/x-java-source',
java => 'text/plain',
#java => 'text/x-java-source',
jcm => 'application/x-java-commerce',
'jfif' => 'image/jpeg',
#jfif => 'image/pjpeg',
'jfif-tbnl' => 'image/jpeg',
jpe => 'image/jpeg',
#jpe => 'image/pjpeg',
jpeg => 'image/jpeg',
#jpeg => 'image/pjpeg',
jpg => 'image/jpeg',
#jpg => 'image/pjpeg',
jps => 'image/x-jps',
#js => 'application/x-javascript',
#js => 'application/javascript',
#js => 'application/ecmascript',
js => 'text/javascript',
#js => 'text/ecmascript',
jut => 'image/jutvision',
kar => 'audio/midi',
#kar => 'music/x-karaoke',
#ksh => 'application/x-ksh',
ksh => 'text/x-script.ksh',
la => 'audio/nspaudio',
#la => 'audio/x-nspaudio',
lam => 'audio/x-liveaudio',
latex => 'application/x-latex',
#lha => 'application/lha',
lha => 'application/octet-stream',
#lha => 'application/x-lha',
lhx => 'application/octet-stream',
list => 'text/plain',
lma => 'audio/nspaudio',
#lma => 'audio/x-nspaudio',
log => 'text/plain',
#lsp => 'application/x-lisp',
lsp => 'text/x-script.lisp',
lst => 'text/plain',
lsx => 'text/x-la-asf',
ltx => 'application/x-latex',
lzh => 'application/octet-stream',
#lzh => 'application/x-lzh',
#lzx => 'application/lzx',
lzx => 'application/octet-stream',
#lzx => 'application/x-lzx',
m => 'text/plain',
#m => 'text/x-m',
m1v => 'video/mpeg',
m2a => 'audio/mpeg',
m2v => 'video/mpeg',
m3u => 'audio/x-mpequrl',
man => 'application/x-troff-man',
map => 'application/x-navimap',
mar => 'text/plain',
mbd => 'application/mbedlet',
'mc$' => 'application/x-magic-cap-package-1.0',
mcd => 'application/mcad',
#mcd => 'application/x-mathcad',
#mcf => 'image/vasa',
mcf => 'text/mcf',
mcp => 'application/netmc',
me => 'application/x-troff-me',
mht => 'message/rfc822',
mhtml => 'message/rfc822',
#mid => 'application/x-midi',
mid => 'audio/midi',
#mid => 'audio/x-mid',
#mid => 'audio/x-midi',
#mid => 'music/crescendo',
#mid => 'x-music/x-midi',
#midi => 'application/x-midi',
midi => 'audio/midi',
#midi => 'audio/x-mid',
#midi => 'audio/x-midi',
#midi => 'music/crescendo',
#midi => 'x-music/x-midi',
mif => 'application/x-frame',
#mif => 'application/x-mif',
mime => 'message/rfc822',
#mime => 'www/mime',
mjf => 'audio/x-vnd.audioexplosion.mjuicemediafile',
mjpg => 'video/x-motion-jpeg',
mm => 'application/base64',
#mm => 'application/x-meme',
mme => 'application/base64',
mod => 'audio/mod',
#mod => 'audio/x-mod',
moov => 'video/quicktime',
mov => 'video/quicktime',
movie => 'video/x-sgi-movie',
#mp2 => 'audio/mpeg',
#mp2 => 'audio/x-mpeg',
mp2 => 'video/mpeg',
#mp2 => 'video/x-mpeg',
#mp2 => 'video/x-mpeq2a',
#mp3 => 'audio/mpeg3',
#mp3 => 'audio/x-mpeg-3',
mp3 => 'video/mpeg',
#mp3 => 'video/x-mpeg',
#mpa => 'audio/mpeg',
mpa => 'video/mpeg',
mpc => 'application/x-project',
mpe => 'video/mpeg',
mpeg => 'video/mpeg',
#mpg => 'audio/mpeg',
mpg => 'video/mpeg',
mpga => 'audio/mpeg',
mpp => 'application/vnd.ms-project',
mpt => 'application/x-project',
mpv => 'application/x-project',
mpx => 'application/x-project',
mrc => 'application/marc',
ms => 'application/x-troff-ms',
mv => 'video/x-sgi-movie',
my => 'audio/make',
mzz => 'application/x-vnd.audioexplosion.mzz',
nap => 'image/naplps',
naplps => 'image/naplps',
nc => 'application/x-netcdf',
ncm => 'application/vnd.nokia.configuration-message',
nif => 'image/x-niff',
niff => 'image/x-niff',
nix => 'application/x-mix-transfer',
nsc => 'application/x-conference',
nvd => 'application/x-navidoc',
o => 'application/octet-stream',
oda => 'application/oda',
omc => 'application/x-omc',
omcd => 'application/x-omcdatamaker',
omcr => 'application/x-omcregerator',
p => 'text/x-pascal',
p10 => 'application/pkcs10',
#p10 => 'application/x-pkcs10',
p12 => 'application/pkcs-12',
#p12 => 'application/x-pkcs12',
p7a => 'application/x-pkcs7-signature',
p7c => 'application/pkcs7-mime',
#p7c => 'application/x-pkcs7-mime',
p7m => 'application/pkcs7-mime',
#p7m => 'application/x-pkcs7-mime',
p7r => 'application/x-pkcs7-certreqresp',
p7s => 'application/pkcs7-signature',
part => 'application/pro_eng',
pas => 'text/pascal',
pbm => 'image/x-portable-bitmap',
pcl => 'application/vnd.hp-pcl',
#pcl => 'application/x-pcl',
pct => 'image/x-pict',
pcx => 'image/x-pcx',
pdb => 'chemical/x-pdb',
pdf => 'application/pdf',
pfunk => 'audio/make',
#pfunk => 'audio/make.my.funk',
pgm => 'image/x-portable-graymap',
#pgm => 'image/x-portable-greymap',
pic => 'image/pict',
pict => 'image/pict',
pkg => 'application/x-newton-compatible-pkg',
pko => 'application/vnd.ms-pki.pko',
pl => 'text/plain',
#pl => 'text/x-script.perl',
plx => 'application/x-pixclscript',
#pm => 'image/x-xpixmap',
pm => 'text/x-script.perl-module',
pm4 => 'application/x-pagemaker',
pm5 => 'application/x-pagemaker',
png => 'image/png',
#pnm => 'application/x-portable-anymap',
pnm => 'image/x-portable-anymap',
pot => 'application/mspowerpoint',
#pot => 'application/vnd.ms-powerpoint',
pov => 'model/x-pov',
ppa => 'application/vnd.ms-powerpoint',
ppm => 'image/x-portable-pixmap',
pps => 'application/mspowerpoint',
#pps => 'application/vnd.ms-powerpoint',
#ppt => 'application/mspowerpoint',
ppt => 'application/powerpoint',
#ppt => 'application/vnd.ms-powerpoint',
#ppt => 'application/x-mspowerpoint',
ppz => 'application/mspowerpoint',
pre => 'application/x-freelance',
prt => 'application/pro_eng',
ps => 'application/postscript',
psd => 'application/octet-stream',
pvu => 'paleovu/x-pv',
pwz => 'application/vnd.ms-powerpoint',
py => 'text/x-script.phyton',
pyc => 'applicaiton/x-bytecode.python',
qcp => 'audio/vnd.qcelp',
qd3 => 'x-world/x-3dmf',
qd3d => 'x-world/x-3dmf',
qif => 'image/x-quicktime',
qt => 'video/quicktime',
qtc => 'video/x-qtc',
qti => 'image/x-quicktime',
qtif => 'image/x-quicktime',
ra => 'audio/x-pn-realaudio',
#ra => 'audio/x-pn-realaudio-plugin',
#ra => 'audio/x-realaudio',
ram => 'audio/x-pn-realaudio',
#ras => 'application/x-cmu-raster',
ras => 'image/cmu-raster',
#ras => 'image/x-cmu-raster',
rast => 'image/cmu-raster',
rexx => 'text/x-script.rexx',
rf => 'image/vnd.rn-realflash',
rgb => 'image/x-rgb',
#rm => 'application/vnd.rn-realmedia',
rm => 'audio/x-pn-realaudio',
rmi => 'audio/mid',
rmm => 'audio/x-pn-realaudio',
rmp => 'audio/x-pn-realaudio',
#rmp => 'audio/x-pn-realaudio-plugin',
rng => 'application/ringing-tones',
#rng => 'application/vnd.nokia.ringing-tone',
rnx => 'application/vnd.rn-realplayer',
roff => 'application/x-troff',
rp => 'image/vnd.rn-realpix',
rpm => 'audio/x-pn-realaudio-plugin',
rt => 'text/richtext',
#rt => 'text/vnd.rn-realtext',
rtf => 'application/rtf',
#rtf => 'application/x-rtf',
#rtf => 'text/richtext',
#rtx => 'application/rtf',
rtx => 'text/richtext',
rv => 'video/vnd.rn-realvideo',
s => 'text/x-asm',
s3m => 'audio/s3m',
saveme => 'application/octet-stream',
sbk => 'application/x-tbook',
#scm => 'application/x-lotusscreencam',
#scm => 'text/x-script.guile',
#scm => 'text/x-script.scheme',
scm => 'video/x-scm',
sdml => 'text/plain',
sdp => 'application/sdp',
#sdp => 'application/x-sdp',
sdr => 'application/sounder',
sea => 'application/sea',
#sea => 'application/x-sea',
set => 'application/set',
sgm => 'text/sgml',
#sgm => 'text/x-sgml',
sgml => 'text/sgml',
#sgml => 'text/x-sgml',
#sh => 'application/x-bsh',
#sh => 'application/x-sh',
#sh => 'application/x-shar',
sh => 'text/x-script.sh',
shar => 'application/x-bsh',
#shar => 'application/x-shar',
shtml => 'text/html',
#shtml => 'text/x-server-parsed-html',
sid => 'audio/x-psid',
sit => 'application/x-sit',
#sit => 'application/x-stuffit',
skd => 'application/x-koan',
skm => 'application/x-koan',
skp => 'application/x-koan',
skt => 'application/x-koan',
sl => 'application/x-seelogo',
smi => 'application/smil',
smil => 'application/smil',
snd => 'audio/basic',
#snd => 'audio/x-adpcm',
sol => 'application/solids',
#spc => 'application/x-pkcs7-certificates',
spc => 'text/x-speech',
spl => 'application/futuresplash',
spr => 'application/x-sprite',
sprite => 'application/x-sprite',
src => 'application/x-wais-source',
ssi => 'text/x-server-parsed-html',
ssm => 'application/streamingmedia',
sst => 'application/vnd.ms-pki.certstore',
step => 'application/step',
stl => 'application/sla',
#stl => 'application/vnd.ms-pki.stl',
#stl => 'application/x-navistyle',
stp => 'application/step',
sv4cpio => 'application/x-sv4cpio',
sv4crc => 'application/x-sv4crc',
svf => 'image/vnd.dwg',
#svf => 'image/x-dwg',
svr => 'application/x-world',
#svr => 'x-world/x-svr',
swf => 'application/x-shockwave-flash',
t => 'application/x-troff',
talk => 'text/x-speech',
tar => 'application/x-tar',
tbk => 'application/toolbook',
#tbk => 'application/x-tbook',
#tcl => 'application/x-tcl',
tcl => 'text/x-script.tcl',
tcsh => 'text/x-script.tcsh',
tex => 'application/x-tex',
texi => 'application/x-texinfo',
texinfo => 'application/x-texinfo',
#text => 'application/plain',
text => 'text/plain',
tgz => 'application/gnutar',
#tgz => 'application/x-compressed',
tif => 'image/tiff',
#tif => 'image/x-tiff',
tiff => 'image/tiff',
#tiff => 'image/x-tiff',
tr => 'application/x-troff',
tsi => 'audio/tsp-audio',
#tsp => 'application/dsptype',
tsp => 'audio/tsplayer',
tsv => 'text/tab-separated-values',
turbot => 'image/florian',
txt => 'text/plain',
uil => 'text/x-uil',
uni => 'text/uri-list',
unis => 'text/uri-list',
unv => 'application/i-deas',
uri => 'text/uri-list',
uris => 'text/uri-list',
ustar => 'application/x-ustar',
#ustar => 'multipart/x-ustar',
#uu => 'application/octet-stream',
uu => 'text/x-uuencode',
uue => 'text/x-uuencode',
vcd => 'application/x-cdlink',
vcs => 'text/x-vcalendar',
vda => 'application/vda',
vdo => 'video/vdo',
vew => 'application/groupwise',
viv => 'video/vivo',
#viv => 'video/vnd.vivo',
vivo => 'video/vivo',
#vivo => 'video/vnd.vivo',
vmd => 'application/vocaltec-media-desc',
vmf => 'application/vocaltec-media-file',
voc => 'audio/voc',
#voc => 'audio/x-voc',
vos => 'video/vosaic',
vox => 'audio/voxware',
vqe => 'audio/x-twinvq-plugin',
vqf => 'audio/x-twinvq',
vql => 'audio/x-twinvq-plugin',
#vrml => 'application/x-vrml',
vrml => 'model/vrml',
#vrml => 'x-world/x-vrml',
vrt => 'x-world/x-vrt',
vsd => 'application/x-visio',
vst => 'application/x-visio',
vsw => 'application/x-visio',
w60 => 'application/wordperfect6.0',
w61 => 'application/wordperfect6.1',
w6w => 'application/msword',
wav => 'audio/wav',
#wav => 'audio/x-wav',
wb1 => 'application/x-qpro',
wbmp => 'image/vnd.wap.wbmp',
web => 'application/vnd.xara',
wiz => 'application/msword',
wk1 => 'application/x-123',
wmf => 'windows/metafile',
wml => 'text/vnd.wap.wml',
wmlc => 'application/vnd.wap.wmlc',
wmls => 'text/vnd.wap.wmlscript',
wmlsc => 'application/vnd.wap.wmlscriptc',
word => 'application/msword',
wp => 'application/wordperfect',
wp5 => 'application/wordperfect',
#wp5 => 'application/wordperfect6.0',
wp6 => 'application/wordperfect',
wpd => 'application/wordperfect',
#wpd => 'application/x-wpwin',
wq1 => 'application/x-lotus',
wri => 'application/mswrite',
#wri => 'application/x-wri',
#wrl => 'application/x-world',
wrl => 'model/vrml',
#wrl => 'x-world/x-vrml',
wrz => 'model/vrml',
#wrz => 'x-world/x-vrml',
wsc => 'text/scriplet',
wsrc => 'application/x-wais-source',
wtk => 'application/x-wintalk',
#xbm => 'image/x-xbitmap',
#xbm => 'image/x-xbm',
'xbm' => 'image/xbm',
'xdr' => 'video/x-amt-demorun',
'xgz' => 'xgl/drawing',
'xif' => 'image/vnd.xiff',
'xl' => 'application/excel',
'xla' => 'application/excel',
#xla => 'application/x-excel',
#xla => 'application/x-msexcel',
'xlb' => 'application/excel',
#xlb => 'application/vnd.ms-excel',
#xlb => 'application/x-excel',
'xlc' => 'application/excel',
#xlc => 'application/vnd.ms-excel',
#xlc => 'application/x-excel',
'xld' => 'application/excel',
#xld => 'application/x-excel',
'xlk' => 'application/excel',
#xlk => 'application/x-excel',
'xll' => 'application/excel',
#xll => 'application/vnd.ms-excel',
#xll => 'application/x-excel',
'xlm' => 'application/excel',
#xlm => 'application/vnd.ms-excel',
#xlm => 'application/x-excel',
'xls' => 'application/excel',
#xls => 'application/vnd.ms-excel',
#xls => 'application/x-excel',
#xls => 'application/x-msexcel',
'xlt' => 'application/excel',
#xlt => 'application/x-excel',
'xlv' => 'application/excel',
#xlv => 'application/x-excel',
'xlw' => 'application/excel',
#xlw => 'application/vnd.ms-excel',
#xlw => 'application/x-excel',
#xlw => 'application/x-msexcel',
'xm' => 'audio/xm',
#xml => 'application/xml',
'xml' => 'text/xml',
'xmz' => 'xgl/movie',
'xpix' => 'application/x-vnd.ls-xpix',
#xpm => 'image/x-xpixmap',
'xpm' => 'image/xpm',
'x-png' => 'image/png',
'xsr' => 'video/x-amt-showrun',
'xwd' => 'image/x-xwd',
#xwd => 'image/x-xwindowdump',
'xyz' => 'chemical/x-pdb',
z => 'application/x-compress',
#z => 'application/x-compressed',
#zip => 'application/x-compressed',
#zip => 'application/x-zip-compressed',
zip => 'application/zip',
#zip => 'multipart/x-zip',
zoo => 'application/octet-stream',
zsh => 'text/x-script.zsh',
);print "LINE=".__LINE__."\n";
@ascii_que=@ascii;print "LINE=".__LINE__."\n";
#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>;print "LINE=".__LINE__."\n";
# open (FH,"<$home_dir/.sh_history") ||
# warn "Cannot open .sh_history file! : $!";print "LINE=".__LINE__."\n";
# my @command_history=<FH>;print "LINE=".__LINE__."\n";
# CORE::close(FH);print "LINE=".__LINE__."\n";
# foreach (@command_history) {
# if (/xterm/ and /$0/) {
# $force_pause=1;last;print "LINE=".__LINE__."\n";
# }
# }
#}
# our $maintainer='Brian Kelly';print "LINE=".__LINE__."\n";
# our $maintainer_phone='';print "LINE=".__LINE__."\n";
#@RCM_Link=('telnet');print "LINE=".__LINE__."\n";
#@RCM_Link=('ssh','telnet');print "LINE=".__LINE__."\n";
#@RCM_Link=('telnet','http');print "LINE=".__LINE__."\n";
# Options: telnet, ssh,
# telnet_proxy, ssh_proxy
# Order from left to right
# determines attempt order.
# Only one method is required.
#@FTM_Link=('ftp');print "LINE=".__LINE__."\n";
@FTM_Link=('sftp','ftp');print "LINE=".__LINE__."\n";
#@FTM_Link=('ftp','http');print "LINE=".__LINE__."\n";
# Options: ftp sftp
# ftp_proxy sftp_proxy
# Same as above.
my $count=0;print "LINE=".__LINE__."\n";
# 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;print "LINE=".__LINE__."\n";
my $param_one=$_[0]||'';print "LINE=".__LINE__."\n";
my $param_two=$_[1]||'';print "LINE=".__LINE__."\n";
my ($stdout,$stderr,$track)=('','','');print "LINE=".__LINE__."\n";
print "\nINFO: main::cleanup() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (keys %semaphores) {
foreach my $ipc_key (keys %semaphores) {
$ipc_key||='';print "LINE=".__LINE__."\n";
next if $ipc_key=~/^\s*$/;print "LINE=".__LINE__."\n";
if (-1<index $semaphores{$ipc_key},'IPC::') {
my $val=$semaphores{$ipc_key}->getval(0)||0;print "LINE=".__LINE__."\n";
if (1<$val) {
$semaphores{$ipc_key}->op(0,-1,&SEM_UNDO);print "LINE=".__LINE__."\n";
} else {
$semaphores{$ipc_key}->remove;print "LINE=".__LINE__."\n";
}
} else {
$semaphores{$ipc_key}->wait(0);print "LINE=".__LINE__."\n";
}
}
}
if ($Net::FullAuto::FA_Core::bdb_locks) {
my $cursor=$Net::FullAuto::FA_Core::bdb_locks->db_cursor();print "LINE=".__LINE__."\n";
my ($lockid,$locks)=('','');print "LINE=".__LINE__."\n";
while ($cursor->c_get($lockid, $locks, DB_NEXT) == 0) {
$locks=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
my $locks=eval $locks;print "LINE=".__LINE__."\n";
my @processes=keys %{$locks};print "LINE=".__LINE__."\n";
if (-1==$#processes) {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_del($lockid);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
foreach my $process (@processes) {
if ($process eq $$) {
delete $locks->{$process};print "LINE=".__LINE__."\n";
}
}
if (keys %{$locks}) {
$locks=Data::Dump::Streamer::Dump($locks)->Out();print "LINE=".__LINE__."\n";
my $status=
$Net::FullAuto::FA_Core::bdb_locks->db_put($lockid,$locks);print "LINE=".__LINE__."\n";
} else {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_del($lockid);print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
undef $Net::FullAuto::FA_Core::bdb_locks;print "LINE=".__LINE__."\n";
}
my $tm='';my $ob='';my %cleansync=();print "LINE=".__LINE__."\n";
my $new_cmd='';my $cmd='';my $clean_master='';print "LINE=".__LINE__."\n";
my @cmd=();my %did_tran=();print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $show1
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($cnct_type eq 'cmd'
&& $hostlabel eq $DeploySMB_Proxy[0]) {
my ($cmd_fh,$cmd_pid,$shell_pid,$cmd)=
@{$Processes{$hostlabel}{$id}{$type}};print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}) {
foreach my $element
(@{$Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}}) {
my $tmpdir=$element->[0];print "LINE=".__LINE__."\n";
my $tdir=$element->[1];print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"cd $tmpdir");print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"rm -rf $tdir");print "LINE=".__LINE__."\n";
}
}
if (defined fileno $cmd_fh) {
$cmd_fh->print("\004");print "LINE=".__LINE__."\n";
my $next=0;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$line=~s/\s*$//s;print "LINE=".__LINE__."\n";
last if $line=~/_funkyPrompt_$/s;print "LINE=".__LINE__."\n";
last if $line=~/Killed by signal 2\.$/s;print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($shell_pid,$kill_arg)
if &testpid($shell_pid);print "LINE=".__LINE__."\n";
if ($cmd_pid) {
if (&testpid($cmd_pid)) {
($stdout,$stderr)=&kill($cmd_pid,$kill_arg);print "LINE=".__LINE__."\n";
$next=1;return;print "LINE=".__LINE__."\n";
}
}
$cmd_fh->print("\003");print "LINE=".__LINE__."\n";
}
}; next if $next;print "LINE=".__LINE__."\n";
}
if ($@) {
print "clean_ERRORRRRR=$@\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
}
foreach my $pid_ts (@pid_ts) {
$cmd_fh->cmd("rm -f *${pid_ts}*");print "LINE=".__LINE__."\n";
}
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;print "LINE=".__LINE__."\n";
$clean_master=2 if $tran[2];print "LINE=".__LINE__."\n";
if ($tran[1] eq $hostlabel &&
$tran[1] ne "__Master_${$}__" && (!exists
$same_host_as_Master{$tran[1]} ||
exists $Hosts{$hostlabel}{'sshport'})) {
my $cmd="cd $tran[0] | sed -e "
."\'s/^/stdout: /\' 2>&1";print "LINE=".__LINE__."\n";
$cmd_fh->cmd($cmd);print "LINE=".__LINE__."\n";
$cmd_fh->cmd("rm -f transfer$tran[3]*tar");print "LINE=".__LINE__."\n";
if ($tran[2]) {
$cmd_fh->cmd('cd ..');print "LINE=".__LINE__."\n";
}
if ($tran[4] && !$savetran) {
$cmd_fh->cmd(
"cmd /c rmdir /s /q transfer$tran[3]");print "LINE=".__LINE__."\n";
if (&test_dir($cmd_fh,"transfer$tran[3]")) {
$cmd_fh->cmd(
"chmod -Rv 777 transfer$tran[3]");print "LINE=".__LINE__."\n";
$cmd_fh->cmd(
"cmd /c rmdir /s /q transfer$tran[3]");print "LINE=".__LINE__."\n";
}
}
} $did_tran{$hostlabel}='-';print "LINE=".__LINE__."\n";
} ($stdout,$stderr)=&kill($shell_pid,$kill_arg)
if &testpid($shell_pid);print "LINE=".__LINE__."\n";
}
if ($cnct_type eq 'ftm') {
my ($ftp_fh,$ftp_pid,$shell_pid,$ig_nore)=
@{$Processes{$hostlabel}{$id}{$type}};print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "FTP_FH_ERRMSG=",$ftp_fh->errmsg,"\n"
if $ftp_fh->errmsg
&& $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
last if $line=~/_funkyPrompt_$|
logout|221\sGoodbye/sx;print "LINE=".__LINE__."\n";
last SC if
$line=~/Connection.*closed|Exit\sstatus\s0/s;print "LINE=".__LINE__."\n";
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last SC if $count++==20;print "LINE=".__LINE__."\n";
} else { $count=0 }
if ($^O eq 'cygwin' ||
(-1<index $line,'password:')) {
$ftp_fh->print("\004");print "LINE=".__LINE__."\n";
} else {
$ftp_fh->print('exit');print "LINE=".__LINE__."\n";
select(undef,undef,undef,0.02);print "LINE=".__LINE__."\n";
# sleep for 1/50th second;print "LINE=".__LINE__."\n";
}
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
print "WHAT IS THE LINE_2 EVALERROR=$@<====\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';print "LINE=".__LINE__."\n";
} else { $ftp_fh->close();die "$@ $!" }
}
}
if (($tran[0] || $hostlabel eq "__Master_${$}__")
&& !exists $did_tran{$hostlabel}) {
$clean_master=1;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
$clean_master=2 if $tran[2];print "LINE=".__LINE__."\n";
$clean_master=3 if $tran[4]
&& $clean_master!=2;print "LINE=".__LINE__."\n";
} $did_tran{$hostlabel}='-';print "LINE=".__LINE__."\n";
}
($stdout,$stderr)=&kill($shell_pid,$kill_arg)
if &testpid($shell_pid);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($ftp_pid,$kill_arg)
if &testpid($ftp_pid);print "LINE=".__LINE__."\n";
$ftp_fh->close();
} else {
my ($cmd_fh,$cmd_pid,$shell_pid,$cmd)=
@{$Processes{$hostlabel}{$id}{$type}};print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}) {
foreach my $element
(@{$Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}}) {
my $tmpdir=$element->[0];print "LINE=".__LINE__."\n";
my $tdir=$element->[1];print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"cd $tmpdir");print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"rm -rf $tdir");print "LINE=".__LINE__."\n";
}
}
if (defined fileno $cmd_fh) {
my $gone=1;my $was_a_local=0;my $exit_flag=0;print "LINE=".__LINE__."\n";
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::gbp->('printf').
"printf $funkyprompt");print "LINE=".__LINE__."\n";
while (my $line=$cmd_fh->get(timeout=>2)) {
print $Net::FullAuto::FA_Core::MRLOG
"cleanup() LINE_3=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (-1<index $line,'logout') {
if (-1<index $line,'Exit status 0') {
last CC;print "LINE=".__LINE__."\n";
} else {
last;print "LINE=".__LINE__."\n";
}
} elsif ($line=~/221\sGoodbye/sx) {
last;print "LINE=".__LINE__."\n";
}
my %tmp_files_dirs=
%Net::FullAuto::FA_Core::tmp_files_dirs;print "LINE=".__LINE__."\n";
if ($line=~/_funkyPrompt_$/s) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&clean_filehandle($cmd_fh);print "LINE=".__LINE__."\n";
if ($cfh_error eq 'Exit status 0') {
last CC;print "LINE=".__LINE__."\n";
} else {
if (!$exit_flag && !$savetran) {
if (exists $tmp_files_dirs{$cmd_fh}) {
my $tmpdir=
${$tmp_files_dirs{$cmd_fh}}[0];print "LINE=".__LINE__."\n";
my $tdir=${$tmp_files_dirs{$cmd_fh}}[1];print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"cd $tmpdir");print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"rm -rf $tdir");print "LINE=".__LINE__."\n";
}
if ($tran[3]) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"cd $tran[0]");print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"rm -f transfer$tran[3].tar");print "LINE=".__LINE__."\n";
if ($tran[4]) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"cmd /c rmdir /s /q ".
"transfer$tran[3]");print "LINE=".__LINE__."\n";
if (&test_dir(
$cmd_fh,"transfer$tran[3]")) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ]
},
"chmod -Rv 777 transfer".
$tran[3]);print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ]
},
"cmd /c rmdir /s /q ".
"transfer$tran[3]");print "LINE=".__LINE__."\n";
}
}
}
} $did_tran{$hostlabel}='-';print "LINE=".__LINE__."\n";
$exit_flag=1;print "LINE=".__LINE__."\n";
$cmd_fh->print('exit');print "LINE=".__LINE__."\n";
}
} 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,'*';print "LINE=".__LINE__."\n";
$gone=0;last CC;print "LINE=".__LINE__."\n";
} elsif (-1<index $line,'Exit status 0') {
last CC;print "LINE=".__LINE__."\n";
} elsif (-1<index $line,
'Connection to localhost closed') {
$was_a_local=1;print "LINE=".__LINE__."\n";
last CC;print "LINE=".__LINE__."\n";
} elsif ($line=~/Connection.*closed/s) {
last CC;print "LINE=".__LINE__."\n";
}
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last CC if $count++==20;print "LINE=".__LINE__."\n";
} else { $count=0 }
if (-1<index $line,'password:'
|| -1<index $line,'Permission denied') {
$cmd_fh->print("\004");print "LINE=".__LINE__."\n";
}
}
}
};print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($@) {
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
if ($tran[0] && !exists $did_tran{$hostlabel}) {
$clean_master=1;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
$clean_master=2 if $tran[2];print "LINE=".__LINE__."\n";
$clean_master=3 if $tran[4]
&& $clean_master!=2;print "LINE=".__LINE__."\n";
}
} elsif ($tran[3] && !$savetran) {
if ($was_a_local) {
$localhost->cmd("rm -f transfer$tran[3]*tar");print "LINE=".__LINE__."\n";
} elsif (!$gone) {
if ($Net::FullAuto::FA_Core::alarm_sounded) {
$cmd_fh->print("\003");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_fh);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($shell_pid,$kill_arg);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($cmd_pid,$kill_arg);print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
$cmd_fh->print("rm -f transfer$tran[3]*tar");print "LINE=".__LINE__."\n";
my $lin='';my $cownt=0;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
$lin=~s/\s*$//s;print "LINE=".__LINE__."\n";
if ($lin=~/_funkyPrompt_/s ||
$lin=~/assword: ?$/m ||
$lin=~/Exit\sstatus\s0/m ||
$lin=~/sion denied.*[)][.]\s*$/s ||
$lin=~/[$|%|>|#|-|:] ?$/s) {
last;print "LINE=".__LINE__."\n";
} elsif ($lin=~/(Connection.+close.+)$|
Exit\sstatus\s-1$|
Killed\sby\ssignal\s2\.$/xm) {
my $one=$1;$one||='';print "LINE=".__LINE__."\n";
if ($one=~/local.+close/) {
$was_a_local=1;last;print "LINE=".__LINE__."\n";
} elsif ($one=~/Connection clo/) {
$gone=1;last;print "LINE=".__LINE__."\n";
}
} elsif ($cownt++<20) {
$gone=1;last;print "LINE=".__LINE__."\n";
} else { $cmd_fh->print("\003") }
}
};print "LINE=".__LINE__."\n";
}
}
print $Net::FullAuto::FA_Core::MRLOG
"GOT EVEN FARTHER HERE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($was_a_local) {
foreach my $pid_ts (@pid_ts) {
$localhost->cmd("rm -f *${pid_ts}*");print "LINE=".__LINE__."\n";
}
} elsif (!$gone) {
foreach my $pid_ts (@pid_ts) {
$cmd_fh->cmd("rm -f *${pid_ts}*");print "LINE=".__LINE__."\n";
}
}
if (!$was_a_local && !$gone) {
$cmd_fh->autoflush(1);print "LINE=".__LINE__."\n";
eval {
$cmd_fh->print('exit');print "LINE=".__LINE__."\n";
while (my $line=$cmd_fh->get) {
$line=~s/\s//g;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"LINE ".__LINE__." ERROR=$@\n"
if $@ && $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
eval {
$localhost->{_sh_pid}||='';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"LINE ".__LINE__." ERROR=$@\n"
if $@ && $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
($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,'*';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($cmd_pid,$kill_arg)
if &testpid($cmd_pid);print "LINE=".__LINE__."\n";
}
}
}
}
}
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,'*';print "LINE=".__LINE__."\n";
if ($tran[3]) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost->{_cmd_handle});print "LINE=".__LINE__."\n";
&handle_error("CLEANUP ERROR -> $cfh_error",'-1') if $cfh_error
&& (-1==index $cfh_error,'Connection to localhost closed');print "LINE=".__LINE__."\n";
($stdout,$stderr)=$localhost->cwd($master_transfer_dir);print "LINE=".__LINE__."\n";
&handle_error("CLEANUP ERROR -> $stderr",'-1') if $stderr;print "LINE=".__LINE__."\n";
($stdout,$stderr)=
$localhost->cmd("rm -f transfer$tran[3]*tar");print "LINE=".__LINE__."\n";
($stdout,$stderr)=
$localhost->cmd("rm -f transfer$tran[3]*tar")
if $stderr;print "LINE=".__LINE__."\n";
&handle_error("CLEANUP ERROR -> $stderr",'-1') if $stderr
&& $stderr!~/^\[[A|C](\[C)+\[K1\s*/s;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
if ($clean_master==2) {
$localhost->cmd('cd ..');print "LINE=".__LINE__."\n";
}
if ($clean_master==2 || $clean_master==3) {
$localhost->cmd(
"cmd /c rmdir /s /q transfer$tran[3]");print "LINE=".__LINE__."\n";
if (&test_dir($localhost->{_cmd_handle},
"transfer$tran[3]")) {
$localhost->cmd(
"chmod -Rv 777 transfer$tran[3]");print "LINE=".__LINE__."\n";
$localhost->cmd(
"cmd /c rmdir /s /q transfer$tran[3]")
if !$savetran;print "LINE=".__LINE__."\n";
}
}
}
}
foreach my $pid_ts (@pid_ts) {
$localhost->cmd("rm -f *${pid_ts}*");print "LINE=".__LINE__."\n";
}
}
if (%Net::FullAuto::FA_Core::tmp_files_dirs &&
exists $Net::FullAuto::FA_Core::tmp_files_dirs
{$localhost->{_cmd_handle}}) {
foreach my $element
(@{$Net::FullAuto::FA_Core::tmp_files_dirs
{$localhost->{_cmd_handle}}}) {
my $tmpdir=$element->[0];print "LINE=".__LINE__."\n";
my $tdir=$element->[1];print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$localhost->{_cmd_handle},
_hostlabel=>[ "__Master_${$}__",'' ] },"cd $tmpdir");print "LINE=".__LINE__."\n";
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$localhost->{_cmd_handle},
_hostlabel=>[ "__Master_${$}__",'' ] },"rm -rf $tdir");print "LINE=".__LINE__."\n";
}
}
$localhost->{_cmd_handle}||='';print "LINE=".__LINE__."\n";
if (defined fileno $localhost->{_cmd_handle}) {
$localhost->{_cmd_handle}->autoflush(1);print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}->print("\004");print "LINE=".__LINE__."\n";
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
while (my $line=$localhost->{_cmd_handle}->get) {
print $Net::FullAuto::FA_Core::MRLOG
"localhost cleanup() LINE=$line<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print "localhost cleanup() LINE=$line<==\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($localhost->{_sh_pid},$kill_arg)
if &testpid($localhost->{_sh_pid});print "LINE=".__LINE__."\n";
if (&testpid($localhost->{_cmd_pid})) {
$localhost->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}->print("\004");print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($localhost->{_cmd_pid},$kill_arg);print "LINE=".__LINE__."\n";
} else {
last
}
}
};print "LINE=".__LINE__."\n";
}
if ($@) {
print "localhost_end_error=$@\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
}
#($stdout,$stderr)=&kill($localhost->{_cmd_pid},$kill_arg);print "LINE=".__LINE__."\n";
#($stdout,$stderr)=&kill($localhost->{_sh_pid},$kill_arg);print "LINE=".__LINE__."\n";
if (defined $master_hostlabel &&
(-1<index $localhost,'=')) {
$username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
&scrub_passwd_file($master_hostlabel,
$username);print "LINE=".__LINE__."\n";
}
%{$localhost}=();undef $localhost;print "LINE=".__LINE__."\n";
%Processes=();print "LINE=".__LINE__."\n";
%Connections=();print "LINE=".__LINE__."\n";
@pid_ts=();print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::makeplan) {
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?
"-m $Net::FullAuto::FA_Core::cygwin_berkeley_db_mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $plan_number=$Net::FullAuto::FA_Core::makeplan->{'Number'}||'';print "LINE=".__LINE__."\n";
my $plan_title =$Net::FullAuto::FA_Core::makeplan->{'Title'}||'';print "LINE=".__LINE__."\n";
my $put_plan=Data::Dump::Streamer::Dump(
$Net::FullAuto::FA_Core::makeplan)->Out();print "LINE=".__LINE__."\n";
if ($plan_number) {
my $pregx=qr/\]quit\[|INT|ERROR/;print "LINE=".__LINE__."\n";
unless ($Net::FullAuto::FA_Core::plan_ignore_error) {
$pregx=qr/\]quit\[|INT/;print "LINE=".__LINE__."\n";
}
unless ($param_two=~/$pregx/) {
my $status=$bdb->db_put($plan_number,$put_plan);print "LINE=".__LINE__."\n";
print "\n\n ################ NEW PLAN ##################\n\n",
" Number: $plan_number\n",
" Title: $plan_title\n\n",
" WAS SUCCESSFULLY CREATED!\n";print "LINE=".__LINE__."\n";
}
}
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
}
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
if ($^O ne 'cygwin') {
print "\n";print "LINE=".__LINE__."\n";
} else {
print "\n\n";print "LINE=".__LINE__."\n";
}
} ReadMode 0;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"INFO: GOING TO CLOSE LOG\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$MRLOG||='';print "LINE=".__LINE__."\n";
CORE::close($MRLOG) if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$MRLOG='';print "LINE=".__LINE__."\n";
$Hosts{"__Master_${$}__"}{'LogFile'}||='';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "FullAuto COMPLETED SUCCESSFULLY on ".localtime()."\n"
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::log
&& exists $Hosts{"__Master_${$}__"}{'LogFile'}
&& $Hosts{"__Master_${$}__"}{'LogFile'}) {
unlink $Hosts{"__Master_${$}__"}{'LogFile'};print "LINE=".__LINE__."\n";
}
return 1 if $param_one eq '__return__';print "LINE=".__LINE__."\n";
exit 1 if $param_one;print "LINE=".__LINE__."\n";
exit 0;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
# Handle INT SIGNAL interruption
$SIG{ INT } = sub{
print "\n\nCAUGHT AN INTERUPT SIGNAL!!\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
unlink $ENV{FA_ACQUIRING_BERKELEY_DB_LOCK}
if exists $ENV{FA_ACQUIRING_BERKELEY_DB_LOCK};print "LINE=".__LINE__."\n";
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
$cleanup=1;&cleanup('','INT') };print "LINE=".__LINE__."\n";
our $alarm_sounded=0;print "LINE=".__LINE__."\n";
$SIG{ ALRM } = sub{ open(AL,">>ALRM.txt");print "LINE=".__LINE__."\n";
print AL scalar(localtime())."\n";print "LINE=".__LINE__."\n";
close AL;print "LINE=".__LINE__."\n";
$alarm_sounded=1;print "LINE=".__LINE__."\n";
print "CAUGHT AN ALRM!! FROM ",caller,"\n";print "LINE=".__LINE__."\n";
$cleanup=1;&cleanup('','ALRM') };print "LINE=".__LINE__."\n";
$SIG{ CHLD } = 'IGNORE';print "LINE=".__LINE__."\n";
my @Hosts=@{&check_Hosts($Net::FullAuto::FA_Core::fa_host)};print "LINE=".__LINE__."\n";
sub username
{
return $Net::FullAuto::FA_Core::username
if $Net::FullAuto::FA_Core::username;print "LINE=".__LINE__."\n";
eval {
die;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $path=$@;print "LINE=".__LINE__."\n";
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;print "LINE=".__LINE__."\n";
eval {
require "$path/fa_global.pm";print "LINE=".__LINE__."\n";
my $mod="fa_global";print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
$username=getlogin || getpwuid($<);print "LINE=".__LINE__."\n";
$username=$Net::FullAuto::fa_global::FA_Sudo{$username}
if exists $Net::FullAuto::fa_global::FA_Sudo{$username};print "LINE=".__LINE__."\n";
return $username;print "LINE=".__LINE__."\n";
}
sub grep_for_string_existence_only
{
my $file=$_[0];print "LINE=".__LINE__."\n";
my $pattern=$_[1];print "LINE=".__LINE__."\n";
my $return_value=0;print "LINE=".__LINE__."\n";
eval {
open(FH,"<$file") || return 0;print "LINE=".__LINE__."\n";
my $keygen_flag=0;print "LINE=".__LINE__."\n";
while (my $line=<FH>) {
if ($line=~/^\[1\]|ssh-rsa/) {
$keygen_flag=1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
if ($line=~/$pattern/) {
$return_value=1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
if ($keygen_flag) {
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
my $output=`ssh-keygen -F localhost 2>&1`;print "LINE=".__LINE__."\n";
$return_value=1 if $output=~/localhost|^\[1\]|ssh-rsa/s;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
return $return_value;print "LINE=".__LINE__."\n";
}
sub version
{
can_load(modules => { "Net::FullAuto" => 0 });print "LINE=".__LINE__."\n";
my $version=<<VERSION;print "LINE=".__LINE__."\n";
This is Net::FullAuto, v$Net::FullAuto::VERSION
(See fullauto -V or fa -V for more detail)
Copyright 2000-2014, Brian M. Kelly
FullAuto may be copied only under the terms of the GNU Affero 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;print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
sub users
{
#package users;print "LINE=".__LINE__."\n";
#use if (!defined $Net::FullAuto::FA_Core::localhost), 'Net::FullAuto';print "LINE=".__LINE__."\n";
#our $fa_code='Net::FullAuto::FA_Core.pm';print "LINE=".__LINE__."\n";
#unless (-1<index $Net::FullAuto::FA_Core::localhost,'=') {
# $main::plan_menu_sub=1;print "LINE=".__LINE__."\n";
# &Net::FullAuto::FA_Core::fa_login();print "LINE=".__LINE__."\n";
# undef $main::plan_menu_sub;print "LINE=".__LINE__."\n";
#}
can_load(modules => { "Term::Menus" => 0 });print "LINE=".__LINE__."\n";
can_load(modules => { "Net::FullAuto" => 0 });print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $term_menus_path=
substr($INC{'Term/Menus.pm'},0,
(rindex $INC{'Term/Menus.pm'},'Term'));print "LINE=".__LINE__."\n";
my $net_fulla_path=
substr($INC{'Net/FullAuto.pm'},0,
(rindex $INC{'Net/FullAuto.pm'},'Net'));print "LINE=".__LINE__."\n";
$term_menus_path=~s/\/share\//\/lib\//
if -1<index $term_menus_path,'share';print "LINE=".__LINE__."\n";
my $o='';print "LINE=".__LINE__."\n";
foreach my $p (@INC) {
$o=$p;print "LINE=".__LINE__."\n";
last if -1<index $o,$term_menus_path;print "LINE=".__LINE__."\n";
last if "$o/" eq $term_menus_path;print "LINE=".__LINE__."\n";
}
my @tmlist=();print "LINE=".__LINE__."\n";
if (-f $o.'/auto/Term/Menus/.packlist') {
open (TH,"<$o/auto/Term/Menus/.packlist");print "LINE=".__LINE__."\n";
while (my $f=<TH>) {
chomp $f;print "LINE=".__LINE__."\n";
push @tmlist,$f;print "LINE=".__LINE__."\n";
}
close(TH);print "LINE=".__LINE__."\n";
}
my @falist=();print "LINE=".__LINE__."\n";
if (-f $o.'/auto/Net/FullAuto/.packlist') {
open (PH,"<$o/auto/Net/FullAuto/.packlist");print "LINE=".__LINE__."\n";
@falist=<PH>;print "LINE=".__LINE__."\n";
close(PH);print "LINE=".__LINE__."\n";
}
my $checkpath='';print "LINE=".__LINE__."\n";
foreach my $file (@falist) {
if (-1<index $file,'Net/FullAuto/Custom') {
$checkpath=substr($file,0,(index $file,'Net/FullAuto/Custom')+19);print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
my $output=`ls -l $checkpath 2>&1`;print "LINE=".__LINE__."\n";
my ($size,$timestampd,$dirname)=('','','');print "LINE=".__LINE__."\n";
my @users=();print "LINE=".__LINE__."\n";
my $nl=0;print "LINE=".__LINE__."\n";
foreach my $line (split "\n", $output) {
print "\n" if $nl==1;print "LINE=".__LINE__."\n";
next unless $line=~/^d/;print "LINE=".__LINE__."\n";
($size,$timestampd,$dirname)=&Net::FullAuto::FA_Core::ls_parse($line);print "LINE=".__LINE__."\n";
next if $dirname eq 'BackUp';print "LINE=".__LINE__."\n";
$nl=1;print "LINE=".__LINE__."\n";
print $dirname;print "LINE=".__LINE__."\n";
}
print "\n" unless $^O eq 'cygwin';print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
#&Net::FullAuto::FA_Core::cleanup();print "LINE=".__LINE__."\n";
}
sub tutorial
{
can_load(modules => { "Term::Menus" => 0 });print "LINE=".__LINE__."\n";
can_load(modules => { "Net::FullAuto" => 0 });print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();
print "USERNAME=$username\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
sub VERSION
{
can_load(modules => { "Term::Menus" => 0 });print "LINE=".__LINE__."\n";
can_load(modules => { "Net::FullAuto" => 0 });print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $term_menus_path=
substr($INC{'Term/Menus.pm'},0,
(rindex $INC{'Term/Menus.pm'},'Term'));print "LINE=".__LINE__."\n";
my $net_fulla_path=
substr($INC{'Net/FullAuto.pm'},0,
(rindex $INC{'Net/FullAuto.pm'},'Net'));print "LINE=".__LINE__."\n";
$term_menus_path=~s/\/share\//\/lib\//
if -1<index $term_menus_path,'share';print "LINE=".__LINE__."\n";
my $o='';print "LINE=".__LINE__."\n";
foreach my $p (@INC) {
$o=$p;print "LINE=".__LINE__."\n";
last if -1<index $o,$term_menus_path;print "LINE=".__LINE__."\n";
last if "$o/" eq $term_menus_path;print "LINE=".__LINE__."\n";
}
my @tmlist=();print "LINE=".__LINE__."\n";
if (-f $o.'/auto/Term/Menus/.packlist') {
open (TH,"<$o/auto/Term/Menus/.packlist");print "LINE=".__LINE__."\n";
while (my $f=<TH>) {
chomp $f;print "LINE=".__LINE__."\n";
push @tmlist,$f;print "LINE=".__LINE__."\n";
}
close(TH);print "LINE=".__LINE__."\n";
}
my @falist=();print "LINE=".__LINE__."\n";
if (-f $o.'/auto/Net/FullAuto/.packlist') {
open (PH,"<$o/auto/Net/FullAuto/.packlist");print "LINE=".__LINE__."\n";
@falist=<PH>;print "LINE=".__LINE__."\n";
close(PH);print "LINE=".__LINE__."\n";
}
my @pl=();my @exe=();my @O=();my %Cust=();my @Dist=();print "LINE=".__LINE__."\n";
my @Tpm=();my @html=();my @Core=();my @README=();my @CUF=();print "LINE=".__LINE__."\n";
foreach my $file (@falist) {
chomp $file;print "LINE=".__LINE__."\n";
if ($file=~/\.pm$/) {
if (-1<index $file,'Distro') {
push @Dist, $file;next;print "LINE=".__LINE__."\n";
} elsif (-1<index $file,'Custom') {
$Cust{$file}='';next;print "LINE=".__LINE__."\n";
} else {
push @Core, $file;print "LINE=".__LINE__."\n";
my $path=$file;print "LINE=".__LINE__."\n";
$path=~s/^(.*)\/.*$/$1/;print "LINE=".__LINE__."\n";
push @Core, "$path/fa_global.pm" if
-e "$path/fa_global.pm";
next
}
} elsif ($file=~/\.pl$/) {
push @pl, $file;next;print "LINE=".__LINE__."\n";
} elsif ($file=~/fullauto(?:\.exe)*$/) {
push @exe, $file;next;print "LINE=".__LINE__."\n";
} elsif ($file=~/1$/) {
push @O, $file;next;print "LINE=".__LINE__."\n";
} elsif ($file=~/html$/) {
push @html, $file;next;print "LINE=".__LINE__."\n";
} elsif ($file=~/3pm/) {
push @Tpm, $file;next;print "LINE=".__LINE__."\n";
} elsif (-1<index $file,'README') {
if (-1<index $file,'Custom/README') {
my $path=$file;print "LINE=".__LINE__."\n";
$path=~s/\/[^\/]+$//;print "LINE=".__LINE__."\n";
opendir(my $dh, $path) || die "can't opendir $path: $!";print "LINE=".__LINE__."\n";
while (my $file=readdir($dh)) {
chomp($file);print "LINE=".__LINE__."\n";
next if $file eq '.';print "LINE=".__LINE__."\n";
next if $file eq '..';print "LINE=".__LINE__."\n";
$Cust{"$path/$file"}='' if $file!~/^[.]|README$/
&& -f "$path/$file";print "LINE=".__LINE__."\n";
if (-d "$path/$file" && ($file eq $username)) {
opendir(my $dc, "$path/$file") ||
die "can't opendir $path/$file: $!";print "LINE=".__LINE__."\n";
while (my $cfile=readdir($dc)) {
chomp($cfile);print "LINE=".__LINE__."\n";
next if $cfile eq '.';print "LINE=".__LINE__."\n";
next if $cfile eq '..';print "LINE=".__LINE__."\n";
if (-d "$path/$file/$cfile") {
opendir(my $du, "$path/$file/$cfile") ||
die "can't opendir $path/$file/$cfile: $!";print "LINE=".__LINE__."\n";
while (my $ufile=readdir($du)) {
chomp($ufile);print "LINE=".__LINE__."\n";
next if $ufile eq '.';print "LINE=".__LINE__."\n";
next if $ufile eq '..';print "LINE=".__LINE__."\n";
push @CUF,"$path/$file/$cfile/$ufile";print "LINE=".__LINE__."\n";
} close $du;print "LINE=".__LINE__."\n";
}
} close $dc;print "LINE=".__LINE__."\n";
}
} closedir $dh;print "LINE=".__LINE__."\n";
}
push @README, $file;print "LINE=".__LINE__."\n";
}
}
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 "LINE=".__LINE__."\n";
print '',(join "\n",@O),"\n" if -1<$#O;print "LINE=".__LINE__."\n";
print '',(join "\n",@Tpm),"\n",
(join "\n",@html),"\n",
(join "\n",@Core),"\n\n",
(join "\n",sort @Dist),"\n\n",
(join "\n",@README),"\n\n",
(join "\n",sort keys %Cust),"\n\n",
(join "\n",sort @CUF),"\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
sub pick
{
return &Menus::pick(@_);print "LINE=".__LINE__."\n";
}
sub Menu
{
can_load(modules => { "Term::Menus" => 0 });print "LINE=".__LINE__."\n";
return &Term::Menus::Menu(@_);print "LINE=".__LINE__."\n";
}
sub get_today
{
my @what=split / +/, scalar localtime(time);print "LINE=".__LINE__."\n";
my $day=$days{$what[0]};print "LINE=".__LINE__."\n";
my $month=$fullmonth{$what[1]};print "LINE=".__LINE__."\n";
my $what="$day, $month $what[2], $what[4]";print "LINE=".__LINE__."\n";
return $what;print "LINE=".__LINE__."\n";
}
sub get_tomorrow
{
my $t=time+86400;print "LINE=".__LINE__."\n";
my @what=split / +/, scalar localtime($t);print "LINE=".__LINE__."\n";
my $day=$days{$what[0]};print "LINE=".__LINE__."\n";
my $month=$fullmonth{$what[1]};print "LINE=".__LINE__."\n";
my $what="$day, $month $what[2], $what[4]";print "LINE=".__LINE__."\n";
return $what;print "LINE=".__LINE__."\n";
}
sub get_now_am_pm
{
my $time=$_[0]||time;print "LINE=".__LINE__."\n";
my $t=unpack('a5',(split / +/, scalar localtime($time))[3]);print "LINE=".__LINE__."\n";
my $i=unpack('a2',$t);print "LINE=".__LINE__."\n";
if ($i<12) {
substr($t,0,1)='' if $i<10;print "LINE=".__LINE__."\n";
return $t.'am';print "LINE=".__LINE__."\n";
} elsif ($i==12) {
return $t.'pm';print "LINE=".__LINE__."\n";
} else {
substr($t,0,2)=unpack('a2',$t)-12;print "LINE=".__LINE__."\n";
return $t.'pm';print "LINE=".__LINE__."\n";
}
}
sub ls_parse
{
my $line=$_[0];my $size='';my $file='';print "LINE=".__LINE__."\n";
my $mn='';my $dy='';my $time=0;my $fileyr='';print "LINE=".__LINE__."\n";
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;print "LINE=".__LINE__."\n";
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;print "LINE=".__LINE__."\n";
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+)+(.*)$/;print "LINE=".__LINE__."\n";
$size=$1;$mn=$Net::FullAuto::FA_Core::month{$2};$dy=$3;$time=$4;print "LINE=".__LINE__."\n";
$file=$5;print "LINE=".__LINE__."\n";
}
my $hr=12;my $mt='00';print "LINE=".__LINE__."\n";
if (length $time==4) {
$fileyr=$time;print "LINE=".__LINE__."\n";
} elsif ($time) {
($hr,$mt)=unpack('a2 @3 a2',$time);print "LINE=".__LINE__."\n";
my $yr=unpack('x1 a2',$Net::FullAuto::FA_Core::thisyear);print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);print "LINE=".__LINE__."\n";
if (time()<$filetime) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
}
}
} else { return 0,0,'' }
return $size, timelocal(0,$mt,$hr,$dy,$mn-1,$fileyr), $file;print "LINE=".__LINE__."\n";
}
sub find_berkeleydb_utils {
my @topcaller=caller;print "LINE=".__LINE__."\n";
my $hlab="localhost - ".hostname;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $db_util=$_[0];print "LINE=".__LINE__."\n";
my $berkeleydb_perl_module_lib='';print "LINE=".__LINE__."\n";
can_load(modules => { "BerkeleyDB" => 0 });print "LINE=".__LINE__."\n";
my $berkeleydb_path=$INC{'BerkeleyDB.pm'};print "LINE=".__LINE__."\n";
$berkeleydb_perl_module_lib=$berkeleydb_path;print "LINE=".__LINE__."\n";
$berkeleydb_perl_module_lib=~s/\/Berkeley/\/auto\/BerkeleyDB\/Berkeley/;print "LINE=".__LINE__."\n";
my $ext=($^O eq 'cygwin')?'dll':'so';print "LINE=".__LINE__."\n";
$berkeleydb_perl_module_lib=~s/pm$/$ext/;print "LINE=".__LINE__."\n";
my $bcmd=$Net::FullAuto::FA_Core::gbp->('strings').'strings '.
"$berkeleydb_perl_module_lib | ".
$Net::FullAuto::FA_Core::gbp->('grep')."grep \"Berkeley DB.*:\"";print "LINE=".__LINE__."\n";
my $bver=`$bcmd`;print "LINE=".__LINE__."\n";
$bver=~s/^.*DB\s+(.*?)\.\d+:.*$/$1/s;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin' && -f "/bin/db${bver}_$db_util.exe") {
return "/bin/db${bver}_$db_util.exe";print "LINE=".__LINE__."\n";
} elsif ((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_'.$db_util;print "LINE=".__LINE__."\n";
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;print "LINE=".__LINE__."\n";
}
} elsif (-d $fa_conf::berkeleydb.'/include') {
if (-f $fa_conf::berkeleydb.'/include/db.h') {
my $dbh=$fa_conf::berkeleydb.'/include/db.h';print "LINE=".__LINE__."\n";
open(FH,"<$fa_conf::berkeleydb/include/db.h")
or &handle_error(
"Cannot open $fa_conf::berkeleydb/include/db.h");print "LINE=".__LINE__."\n";
my @finc=<FH>;print "LINE=".__LINE__."\n";
close(FH);print "LINE=".__LINE__."\n";
foreach my $line (@finc) {
if ($line=~/^.*VERSION.*$bver.*$/) {
if (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_'.$db_util;print "LINE=".__LINE__."\n";
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;print "LINE=".__LINE__."\n";
}
}
}
&handle_error("Cannot Locate BerkeleyDB installation");print "LINE=".__LINE__."\n";
} elsif (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_'.$db_util;print "LINE=".__LINE__."\n";
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;print "LINE=".__LINE__."\n";
} else {
&handle_error("Cannot Locate BerkeleyDB db_$db_util utility");print "LINE=".__LINE__."\n";
}
} elsif (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_'.$db_util;print "LINE=".__LINE__."\n";
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' && (-f "/bin/db${bver}_$db_util.exe")) {
return "/bin/db${bver}_$db_util.exe";print "LINE=".__LINE__."\n";
} else {
&handle_error("Cannot Locate BerkeleyDB db_$db_util utility");print "LINE=".__LINE__."\n";
}
} else {
my @output=();print "LINE=".__LINE__."\n";
my $greppath=$Net::FullAuto::FA_Core::gbp->('grep');print "LINE=".__LINE__."\n";
my $testgrep =`${greppath}grep -H 2>&1`;print "LINE=".__LINE__."\n";
my $testgrep2=`${greppath}grep 2>&1`;print "LINE=".__LINE__."\n";
my $grepopt='';print "LINE=".__LINE__."\n";
if ((-1==index $testgrep,'illegal option')
&& (-1==index $testgrep2,'-insvxbhwyu')) {
$grepopt='-H ';print "LINE=".__LINE__."\n";
}
my $find_cmd1=$Net::FullAuto::FA_Core::gbp->('find')."find ";print "LINE=".__LINE__."\n";
my $find_cmd2=" -name \"*.h\" ".
"| ".$Net::FullAuto::FA_Core::gbp->('xargs')."xargs ".
$greppath."grep ".
"${grepopt}DB_VERSION_STRING";print "LINE=".__LINE__."\n";
print "\nSearching for latest verison of BerkeleyDB.\n".
"This may take up to five minutes ...\n\n";print "LINE=".__LINE__."\n";
foreach my $dir ('/usr/local/',
'/usr/','/opt/',(getpwuid $>)[7].'/') {
next if unpack('a1',$dir) eq '.';print "LINE=".__LINE__."\n";
next unless -d $dir;print "LINE=".__LINE__."\n";
opendir(DIR, $dir) or die $!;print "LINE=".__LINE__."\n";
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")));print "LINE=".__LINE__."\n";
if (-d $dir.$file) {
print "Searching $dir$file ...\n";print "LINE=".__LINE__."\n";
my @subout=`$find_cmd1\"$dir$file\"$find_cmd2`;print "LINE=".__LINE__."\n";
if (-1<$#subout) {
require CPAN::Config;print "LINE=".__LINE__."\n";
my $ccon=(defined $CPAN::Config &&
exists $CPAN::Config->{cpan_home})?
$CPAN::Config->{cpan_home}:'';print "LINE=".__LINE__."\n";
my @vers=();my %verhash=();print "LINE=".__LINE__."\n";
foreach my $version (@subout) {
next if (-1<index $version, $ccon) ||
(-1<index $version, 'Net-FullAuto-') ||
$version!~/db.h:.*DB_VERSION_STRING/;print "LINE=".__LINE__."\n";
my @fileparts=split 'db.h:', $version;print "LINE=".__LINE__."\n";
$fileparts[1]=~s/^.*DB (\d+[^:]+):.*$/$1/;print "LINE=".__LINE__."\n";
if (-1<index $fileparts[1], $bver) {
my $bintest=$subout[0];print "LINE=".__LINE__."\n";
substr($bintest,(rindex $bintest,'include'))='bin';print "LINE=".__LINE__."\n";
$berkeleydb=substr($bintest,0,-4)
if -d $bintest;print "LINE=".__LINE__."\n";
}
}
}
}
last if $berkeleydb;print "LINE=".__LINE__."\n";
} last if $berkeleydb;print "LINE=".__LINE__."\n";
}
$berkeleydb||='';print "LINE=".__LINE__."\n";
if ($berkeleydb) {
my $fconf=$Hosts{"__Master_${$}__"}{'FA_Core'}.'Custom/'.
$Net::FullAuto::FA_Core::fa_conf;print "LINE=".__LINE__."\n";
open(CH,"+<$fconf") or &handle_error("Cannot open $fconf");print "LINE=".__LINE__."\n";
flock CH, 2;print "LINE=".__LINE__."\n";
my @data=<CH>;print "LINE=".__LINE__."\n";
my $bd=0;my @new=();print "LINE=".__LINE__."\n";
foreach my $ln (@data) {
if (($bd==0) && ($ln=~/^\s*[#]*\s*our\s+[\$]berkeleydb\s*=/)) {
push @new, "our \$berkeleydb = \"$berkeleydb\";\n";print "LINE=".__LINE__."\n";
$bd=1;print "LINE=".__LINE__."\n";
} else {
push @new, $ln;print "LINE=".__LINE__."\n";
}
}
unless ($bd) {
@new=();print "LINE=".__LINE__."\n";
foreach my $ln (@data) {
my $l=$ln;print "LINE=".__LINE__."\n";
if (($bd==0) &&
($l=~/^\s*[#]*\s*our\s+(?!ISA|VERSION|EXPORT)/)) {
push @new, "our \$berkeleydb = \"".
$berkeleydb."\";\n";print "LINE=".__LINE__."\n";
push @new, $ln;print "LINE=".__LINE__."\n";
$bd=1;print "LINE=".__LINE__."\n";
} else {
push @new, $ln;print "LINE=".__LINE__."\n";
}
}
}
seek CH, 0, 0;print "LINE=".__LINE__."\n";
truncate CH, 0;print "LINE=".__LINE__."\n";
print CH @new;print "LINE=".__LINE__."\n";
close CH;print "LINE=".__LINE__."\n";
}
return $berkeleydb.'/bin/db_'.$db_util;print "LINE=".__LINE__."\n";
}
}
sub cat {
eval {
die;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $path=$@;print "LINE=".__LINE__."\n";
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;print "LINE=".__LINE__."\n";
$username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
chomp($path);print "LINE=".__LINE__."\n";
my $cpath=$path."Custom/$username/";print "LINE=".__LINE__."\n";
my $arg=$_[0];print "LINE=".__LINE__."\n";
if (-e $arg) {
if (-r $arg) {
if ($arg=~/^$cpath/) {
open (FH,"<$arg") ||
(print STDERR "\n\n FullAuto cannot open $arg $!\n\n"
&& exit 1);print "LINE=".__LINE__."\n";
my $file='';print "LINE=".__LINE__."\n";
while (my $line=<FH>) {
$file.=$line;print "LINE=".__LINE__."\n";
}
close(FH);print "LINE=".__LINE__."\n";
print $file;print "LINE=".__LINE__."\n";
} else {
print STDERR "\n FATAL ERROR: The user $username is not",
" authorized to view - \n\n $arg\n\n";print "LINE=".__LINE__."\n";
}
} else {
print STDERR "\n FATAL ERROR: FullAuto cannot read",
" - \n\n $arg\n\n";print "LINE=".__LINE__."\n";
}
} else {
print STDERR "\n FATAL ERROR:\n\n $arg\n\n DOES NOT EXIST\n\n";print "LINE=".__LINE__."\n";
}
exit;print "LINE=".__LINE__."\n";
}
sub edit {
eval {
die;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $path=$@;print "LINE=".__LINE__."\n";
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
chomp($path);print "LINE=".__LINE__."\n";
my $cpath=$path."Custom/$username/";print "LINE=".__LINE__."\n";
my $tpath=$path;print "LINE=".__LINE__."\n";
$tpath=~s/Net.*//;print "LINE=".__LINE__."\n";
our $fa_code='';print "LINE=".__LINE__."\n";
our $fa_conf='';print "LINE=".__LINE__."\n";
our $fa_host='';print "LINE=".__LINE__."\n";
our $fa_maps='';print "LINE=".__LINE__."\n";
our $fa_menu='';print "LINE=".__LINE__."\n";
require Term::Menus;print "LINE=".__LINE__."\n";
if (defined $Term::Menus::fa_conf) {
$fa_conf=$Term::Menus::fa_conf;print "LINE=".__LINE__."\n";
if (-d $tpath.'Net/FullAuto/Custom/'.$username) {
eval {
require $fa_conf->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fa_conf=$mod.'.pm';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
warn "ERROR=$@\n";print "LINE=".__LINE__."\n";
}
}
}
if (defined $Term::Menus::fa_code) {
$fa_code=substr($Term::Menus::fa_code->[0],
(rindex $Term::Menus::fa_code->[0],'/')+1);print "LINE=".__LINE__."\n";
}
if (defined $Term::Menus::fa_host) {
$fa_host=substr($Term::Menus::fa_host->[0],
(rindex $Term::Menus::fa_host->[0],'/')+1);print "LINE=".__LINE__."\n";
}
if (defined $Term::Menus::fa_maps) {
$fa_maps=substr($Term::Menus::fa_maps->[0],
(rindex $Term::Menus::fa_maps->[0],'/')+1);print "LINE=".__LINE__."\n";
}
if (defined $Term::Menus::fa_menu) {
$fa_menu=substr($Term::Menus::fa_menu->[0],
(rindex $Term::Menus::fa_menu->[0],'/')+1);print "LINE=".__LINE__."\n";
}
my $editor='';print "LINE=".__LINE__."\n";
$fa_conf::editor||='';print "LINE=".__LINE__."\n";
unless ($editor=$fa_conf::editor) {
if ($^O eq 'cygwin') {
my $mount=`/bin/mount -p`;print "LINE=".__LINE__."\n";
$mount=~s/^.*(\/\S+).*$/$1/s;print "LINE=".__LINE__."\n";
if (-e $mount.
'/c/Program Files/Windows NT/Accessories/wordpad.exe') {
$editor=$mount.
'/c/Program Files/Windows NT/Accessories/wordpad.exe';print "LINE=".__LINE__."\n";
} elsif (-e '/bin/vim-nox.exe') {
$editor='/bin/vim-nox.exe';print "LINE=".__LINE__."\n";
}
} else {
if (-e '/usr/bin/vi') {
$editor='/usr/bin/vi';print "LINE=".__LINE__."\n";
} elsif (-e '/bin/vi') {
$editor='/bin/vi';print "LINE=".__LINE__."\n";
} elsif (-e '/usr/bin/emacs') {
$editor='/usr/bin/emacs';print "LINE=".__LINE__."\n";
}
}
}
my $savdir=Cwd::cwd();print "LINE=".__LINE__."\n";
if ($_[0]=~/ho*s*t*|^fa_host$/i) {
$cpath.='Host';print "LINE=".__LINE__."\n";
system("cd $cpath;\"$editor\" ".
"$fa_host;cd \"$savdir\"");print "LINE=".__LINE__."\n";
} elsif ($_[0]=~/^m$|^me$|^men$|^menu$|^fa_menu$/i) {
$cpath.='Menu';print "LINE=".__LINE__."\n";
$fa_menu=~s/^(fa_.*)_demo(.pm)$/$1$2/
unless -f "$cpath./$fa_menu";print "LINE=".__LINE__."\n";
system("cd $cpath;\"$editor\" ".
"$fa_menu;cd \"$savdir\"");print "LINE=".__LINE__."\n";
} elsif ($_[0]=~/map*s*|^fa_maps$/i) {
$cpath.='Maps';print "LINE=".__LINE__."\n";
system("cd $cpath;\"$editor\" ".
"$fa_maps;cd \"$savdir\"");print "LINE=".__LINE__."\n";
} elsif ($_[0]=~/^c$|^co$|^cod$|^code$|^fa_code$/i) {
$cpath.='Code';print "LINE=".__LINE__."\n";
$fa_code=~s/^(fa_.*)_demo(.pm)$/$1$2/
unless -f "$cpath./$fa_code";print "LINE=".__LINE__."\n";
system("cd $cpath;\"$editor\" ".
"$fa_code;cd \"$savdir\"");print "LINE=".__LINE__."\n";
} elsif ($_[0]=~/con*f*|^fa_conf$/i) {
$cpath.='Conf';print "LINE=".__LINE__."\n";
system("cd $cpath;\"$editor\" ".
"$fa_conf;cd \"$savdir\"");print "LINE=".__LINE__."\n";
} elsif ($_[0]=~/f/) {
system("cd $path;\"$editor\" FA_Core.pm;cd \"$savdir\"");print "LINE=".__LINE__."\n";
} elsif ($_[0]=~/t/) {
system("cd ${tpath}Term;\"$editor\" Menus.pm;cd \"$savdir\"");
} else {
my $stderr='';my $stdout='';print "LINE=".__LINE__."\n";
chdir $cpath;print "LINE=".__LINE__."\n";
($stdout,$stderr)=cmd($Net::FullAuto::FA_Core::gbp->('ls')."ls -lR");print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
my @files=split "\n", $stdout;print "LINE=".__LINE__."\n";
my @file=();my $dirr='';print "LINE=".__LINE__."\n";
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;print "LINE=".__LINE__."\n";
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;print "LINE=".__LINE__."\n";
foreach my $file (@files) {
next if $file=~/^\s*$/;print "LINE=".__LINE__."\n";
next if unpack('a1',$file) eq 'd';print "LINE=".__LINE__."\n";
next if $file=~/^total/;print "LINE=".__LINE__."\n";
next if $file eq '.:';print "LINE=".__LINE__."\n";
if (unpack('a2',$file) eq './') {
$dirr=unpack('x2a*',$file);print "LINE=".__LINE__."\n";
chop($dirr);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
chomp($file);print "LINE=".__LINE__."\n";
next if $file=~/\/$/;print "LINE=".__LINE__."\n";
next if $file eq 'README';print "LINE=".__LINE__."\n";
if ($file=~s/^.*\s+($rx1|$rx2)$/$1/) {
$file=~
s/^\d+\s+\w\w\w\s+\d+\s+(?:\d\d:\d\d\s+|\d\d\d\d\s+)+(.*)$/$1/;print "LINE=".__LINE__."\n";
}
push @file,$username.'/'.$dirr.'/'.$file;print "LINE=".__LINE__."\n";
}
my $owner=getpwuid(${stat($path)}[4]);print "LINE=".__LINE__."\n";
if ($owner eq $username) {
($stdout,$stderr)=cmd($Net::FullAuto::FA_Core::gbp->('ls').
"ls -1 ..");print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
foreach my $file (split "\n", $stdout) {
push @file, "Template $file" if $file=~/[.]pm$/;print "LINE=".__LINE__."\n";
}
push @file, "Global Settings fa_global.pm";print "LINE=".__LINE__."\n";
}
my %Menu_1=(
Item_1 => {
Text => "]C[",
Convey => \@file,
},
Select => 'One',
Banner => "\n Choose a File to Edit :"
);print "LINE=".__LINE__."\n";
my $file=Menu(\%Menu_1);print "LINE=".__LINE__."\n";
if ($file eq ']quit[') {
print "\n";print "LINE=".__LINE__."\n";
exit;print "LINE=".__LINE__."\n";
}
chdir '..';print "LINE=".__LINE__."\n";
$file=~s/^Template (.*)/$1/;print "LINE=".__LINE__."\n";
chdir '..' if $file=~s/^Global Settings (.*)/$1/;print "LINE=".__LINE__."\n";
system("\"$editor\" $file");print "LINE=".__LINE__."\n";
chdir $savdir;print "LINE=".__LINE__."\n";
}
exit;print "LINE=".__LINE__."\n";
}
my $today=unpack('x2a2',$invoked[7]);print "LINE=".__LINE__."\n";
my $curmonth=unpack('a2',$invoked[7]);print "LINE=".__LINE__."\n";
my $fullmonth=$month[$curmonth-1];print "LINE=".__LINE__."\n";
$fullmonth=~s/\s*$//;print "LINE=".__LINE__."\n";
my $todays_date="$fullmonth $today, $curyear";print "LINE=".__LINE__."\n";
my $endyear=$curyear + 20;print "LINE=".__LINE__."\n";
my %mdates=();print "LINE=".__LINE__."\n";
my $lastday='';print "LINE=".__LINE__."\n";
my $showmins=sub { package showmins;print "LINE=".__LINE__."\n";
my $datechosen=']P[';print "LINE=".__LINE__."\n";
$datechosen=~s/^(?:Today|Tomorrow) - //;print "LINE=".__LINE__."\n";
$datechosen=~s/^[A-Za-z]+, //;print "LINE=".__LINE__."\n";
my @hrmn=();print "LINE=".__LINE__."\n";
if ($datechosen eq $todays_date) {
my $now=unpack('a2',(split ':',
&Net::FullAuto::FA_Core::get_now_am_pm)[1]);print "LINE=".__LINE__."\n";
$now++;print "LINE=".__LINE__."\n";
foreach my $hr (@hours[$invoked[4]..23]) {
foreach my $mn ($now..59) {
if (length $mn==1) {
$mn='0'.$mn;print "LINE=".__LINE__."\n";
}
push @hrmn, unpack('a3',$hr).$mn.unpack('x5a2',$hr);print "LINE=".__LINE__."\n";
} $now=0;print "LINE=".__LINE__."\n";
} return @hrmn;print "LINE=".__LINE__."\n";
} else {
foreach my $hr (@hours[0..23]) {
foreach my $mn (0..59) {
if (length $mn==1) {
$mn='0'.$mn;print "LINE=".__LINE__."\n";
}
push @hrmn, unpack('a3',$hr).$mn.unpack('x5a2',$hr);print "LINE=".__LINE__."\n";
}
} return @hrmn;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
my $hours=sub { package hours;print "LINE=".__LINE__."\n";
my $date_chosen=']P[';print "LINE=".__LINE__."\n";
$date_chosen=~s/^(?:Today|Tomorrow) - //;print "LINE=".__LINE__."\n";
$date_chosen=~s/^[A-Za-z]+, //;print "LINE=".__LINE__."\n";
if ($date_chosen eq $todays_date) {
my $in=$invoked[4]+1;print "LINE=".__LINE__."\n";
return (@hours[$in..23])
} else { return @hours } };print "LINE=".__LINE__."\n";
my $cal_months=sub { package cal_months;print "LINE=".__LINE__."\n";
my $yr=']P[';print "LINE=".__LINE__."\n";
my @munths=();print "LINE=".__LINE__."\n";
my $cmonth=$curmonth-1;print "LINE=".__LINE__."\n";
if ($curyear==$yr) {
if ($curmonth==12) {
@munths=$month[11];print "LINE=".__LINE__."\n";
} else {
@munths=@month[$cmonth..11];print "LINE=".__LINE__."\n";
}
} else {
@munths=@month;print "LINE=".__LINE__."\n";
}
my @new=map { $_.' '.']P[' } @munths;print "LINE=".__LINE__."\n";
return @new };print "LINE=".__LINE__."\n";
my $currmonth=$curmonth;print "LINE=".__LINE__."\n";
foreach my $year ($curyear..$endyear) {
my $cnt=0;print "LINE=".__LINE__."\n";
if ($year ne $curyear) {
$currmonth=1;print "LINE=".__LINE__."\n";
} else {
$cnt=$currmonth-1;print "LINE=".__LINE__."\n";
}
foreach my $mth ($currmonth..12) {
$lastday=POSIX::mktime(0,0,0,0,$mth-1+1,$year-1900,0,0,-1);print "LINE=".__LINE__."\n";
my $d=localtime($lastday);print "LINE=".__LINE__."\n";
my @d=split ' ',$d;print "LINE=".__LINE__."\n";
$mdates{$year}{$month[$cnt++]}=$d[2];print "LINE=".__LINE__."\n";
}
}
my $fulldays=sub { package fulldays;print "LINE=".__LINE__."\n";
my ($a,$b)=('','');print "LINE=".__LINE__."\n";
($a,$b)=split / +/, ']P[';print "LINE=".__LINE__."\n";
my $c=pack('A9',$a);print "LINE=".__LINE__."\n";
my @n=();print "LINE=".__LINE__."\n";
my $s=1;print "LINE=".__LINE__."\n";
$s=$today if $b eq $curyear &&
-1<index $month[$curmonth-1],$a;print "LINE=".__LINE__."\n";
foreach my $d ($s..$mdates{$b}{$c}) {
$d='0'.$d if length $d==1;print "LINE=".__LINE__."\n";
push @n, $a.' '.$d.', '.$b;print "LINE=".__LINE__."\n";
}
return @n };print "LINE=".__LINE__."\n";
my $track='';print "LINE=".__LINE__."\n";
my %show_mins=(
Name => 'show_mins',
Item_1=> {
Text => "]C[",
Convey => $showmins,
Result => sub{ my $previous_selection='"]P[{select_cal_days}"';print "LINE=".__LINE__."\n";
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 :",
);print "LINE=".__LINE__."\n";
my %select_hour=(
Name => 'select_hour',
Item_1=> {
Text => "Show Minutes",
Result => \%show_mins,
},
Item_2=> {
Text => "]C[",
Convey => $hours,
Result => sub{ my $previous_selection=']P[';print "LINE=".__LINE__."\n";
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 :",
);print "LINE=".__LINE__."\n";
my %select_cal_days=(
Name => 'select_cal_days',
Item_1=> {
Text => "]C[",
Convey => $fulldays,
Result => \%select_hour,
},
Banner=> ' Please Select a Password Expiration Date :'
);print "LINE=".__LINE__."\n";
my %select_cal_months=(
Name => 'select_cal_months',
Item_1=> {
Text => "]C[",
Convey => $cal_months,
Result => \%select_cal_days,
},
Banner=> ' Please Select a Month :'
);print "LINE=".__LINE__."\n";
my %calendar_years=(
Name => 'calendar_years',
Item_1=> {
Text => "]C[",
Convey => [$curyear..$endyear],
Result => \%select_cal_months,
},
Banner=> ' Please Select a Year :'
);print "LINE=".__LINE__."\n";
sub openplandb {
my $track='';print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
return $bdb,$dbenv;print "LINE=".__LINE__."\n";
}
my $select_time_result_sub = sub {
package select_time_result_sub;print "LINE=".__LINE__."\n";
use Net::FullAuto::FA_Core qw/%month timelocal/;print "LINE=".__LINE__."\n";
my $selection="]S[{select_minutes|select_hours|".
"select_days|select_weeks|select_months}";print "LINE=".__LINE__."\n";
$selection=~s/^["]//;print "LINE=".__LINE__."\n";
$selection=~s/["]$//;print "LINE=".__LINE__."\n";
my ($num,$type)=('','');print "LINE=".__LINE__."\n";
my $expires=0;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
($num,$type)=split /\s+/, $selection;print "LINE=".__LINE__."\n";
if ($num!~/^\d/) {
my @d=split /,* +/, $selection;print "LINE=".__LINE__."\n";
my $mn=unpack('a3',$d[0]);print "LINE=".__LINE__."\n";
if (defined $d[3] && $d[3]) {
my $ap=substr($d[3],-2);print "LINE=".__LINE__."\n";
my ($h,$m)=('','');print "LINE=".__LINE__."\n";
($h,$m)=split ':',substr($d[3],0,-2);print "LINE=".__LINE__."\n";
$h+=12 if $ap eq 'pm' && $h!=12;print "LINE=".__LINE__."\n";
my $mon=$month{$mn} if $mn && exists $month{$mn};print "LINE=".__LINE__."\n";
$mon||=1;print "LINE=".__LINE__."\n";
my $day=$d[1] if defined $d[1] && $d[1];print "LINE=".__LINE__."\n";
$day||=1;print "LINE=".__LINE__."\n";
$expires=&Net::FullAuto::FA_Core::timelocal(
0,$m,$h,$day,$mon-1,$d[2]);print "LINE=".__LINE__."\n";
} else {
my $mon=$month{$mn} if $mn && exists $month{$mn};print "LINE=".__LINE__."\n";
$mon||=1;print "LINE=".__LINE__."\n";
my $day=$d[1] if defined $d[1] && $d[1];print "LINE=".__LINE__."\n";
$day||=1;print "LINE=".__LINE__."\n";
$expires=&Net::FullAuto::FA_Core::timelocal(
0,0,0,$day,$mon-1,$d[2]);print "LINE=".__LINE__."\n";
}
} elsif ($type=~/Min/) {
$expires=time + $num * 60;print "LINE=".__LINE__."\n";
} elsif ($type=~/Hour/) {
$expires=time + $num * 3600;print "LINE=".__LINE__."\n";
} elsif ($type=~/Day/) {
$expires=time + $num * 86400;print "LINE=".__LINE__."\n";
} elsif ($type=~/Week/) {
$expires=time + $num * 604800;print "LINE=".__LINE__."\n";
} elsif ($type=~/Month/) {
$expires=time + $num * 2592000;print "LINE=".__LINE__."\n";
}
my $previous="]!P[{existing_plans}";print "LINE=".__LINE__."\n";
if ($previous=~/[]]!P[[][{]existing_plans[}]/) {
return $expires;print "LINE=".__LINE__."\n";
} else {
my ($bdb,$dbenv)=&Net::FullAuto::FA_Core::openplandb();print "LINE=".__LINE__."\n";
my $cursor=$bdb->db_cursor();print "LINE=".__LINE__."\n";
my ($k,$v)=('','');print "LINE=".__LINE__."\n";
my $planhash={};print "LINE=".__LINE__."\n";
my $plan_number=$previous;print "LINE=".__LINE__."\n";
$plan_number=~s/^.*:\s+(\d+)\s+.*$/$1/;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
#print "WHAT IS K=$k<== and PLAN=$plan_number\n";print "LINE=".__LINE__."\n";
if ($k eq $plan_number) {
$v=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$planhash=eval $v;print "LINE=".__LINE__."\n";
$planhash->{'Title'}||='';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
$planhash->{'Expires'}=$expires;print "LINE=".__LINE__."\n";
my $put_plan=Data::Dump::Streamer::Dump($planhash)->Out();print "LINE=".__LINE__."\n";
my $status=$bdb->db_put($plan_number,$put_plan);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return '{activate_or_disable_expiration}<';print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
my %select_minutes=(
Name => 'select_minutes',
Item_1=> {
Text => "1 Minute",
Result => $select_time_result_sub,
},
Item_2=> {
Text => "]C[ Minutes",
Convey => [2,3,4,5,6,7,8,9],
Result => $select_time_result_sub,
},
Item_3=> {
Text => "]C[ Minutes",
Convey => [10..60],
Result => $select_time_result_sub,
},
Banner => ' Choose Time :',
);print "LINE=".__LINE__."\n";
my %select_hours=(
Name => 'select_hours',
Item_1=> {
Text => "1 Hour",
Result => $select_time_result_sub,
},
Item_2=> {
Text => "]C[ Hours",
Convey => [2,3,4,5,6,7,8,9],
Result => $select_time_result_sub,
},
Item_3=> {
Text => "]C[ Hours",
Convey => [10..24],
Result => $select_time_result_sub,
},
Banner => ' Choose Time :',
);print "LINE=".__LINE__."\n";
my %select_days=(
Name => 'select_days',
Item_1=> {
Text => "1 Day",
Result => $select_time_result_sub,
},
Item_2=> {
Text => "]C[ Days",
Convey => [2,3,4,5,6,7,8,9],
Result => $select_time_result_sub,
},
Item_3=> {
Text => "]C[ Days",
Convey => [10..365],
Result => $select_time_result_sub,
},
Banner => ' Choose Time :',
);print "LINE=".__LINE__."\n";
my %select_weeks=(
Name => 'select_weeks',
Item_1=> {
Text => "1 Week",
Result => $select_time_result_sub,
},
Item_2=> {
Text => "]C[ Weeks",
Convey => [2,3,4,5,6,7,8,9],
Result => $select_time_result_sub,
},
Item_3=> {
Text => "]C[ Weeks",
Convey => [10..53],
Result => $select_time_result_sub,
},
Banner => ' Choose Time :',
);print "LINE=".__LINE__."\n";
my %select_months=(
Name => 'select_months',
Item_1=> {
Text => "1 Month",
Result => $select_time_result_sub,
},
Item_2=> {
Text => "]C[ Months",
Convey => [2,3,4,5,6,7,8,9],
Result => $select_time_result_sub,
},
Item_3=> {
Text => "]C[ Months",
Convey => [10..12],
Result => $select_time_result_sub,
},
Banner => " Choose Time in Months (A Month is 30 Days)\n\n".
" [Hint: Use FULL CALENDAR for more precision]:",
);print "LINE=".__LINE__."\n";
my $ask_exp_banner_sub = sub {
my $banner='';print "LINE=".__LINE__."\n";
my $caller="]P[";print "LINE=".__LINE__."\n";
$caller=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
if ($caller eq 'Set New Expiration') {
my $plan=']!P[{existing_plans}';print "LINE=".__LINE__."\n";
$plan=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " Choose the Expiration Time for\n\n".
" $plan";print "LINE=".__LINE__."\n";
} else {
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
return " 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):"
}
};print "LINE=".__LINE__."\n";
my %ask_exp=(
Name => '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 => $ask_exp_banner_sub,
);print "LINE=".__LINE__."\n";
my $get_expiration_sub=sub {
package get_expiration_sub;print "LINE=".__LINE__."\n";
use Net::FullAuto::FA_Core qw/%days @month/;print "LINE=".__LINE__."\n";
my $arg=']!P[{existing_plans}';print "LINE=".__LINE__."\n";
$arg=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
my $plan=&Net::FullAuto::FA_Core::getplan($arg);print "LINE=".__LINE__."\n";
my $return="\n Choose an expiration action for\n\n $arg:\n";print "LINE=".__LINE__."\n";
if (exists $plan->{Expires} && $plan->{Expires} &&
$plan->{Expires} ne 'never') {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
localtime($plan->{Expires});print "LINE=".__LINE__."\n";
my $m=$month[$mon];$m=~s/\s*$//;print "LINE=".__LINE__."\n";
$year += 1900;my $xp='--EXPIRED--';print "LINE=".__LINE__."\n";
$xp='EXPIRES' if time<$plan->{Expires};print "LINE=".__LINE__."\n";
$return.="\n PLAN $xp => $days{$wday} $m $mday, $year ".
&Net::FullAuto::FA_Core::get_now_am_pm($plan->{Expires})." ".
POSIX::strftime("%Z",localtime($plan->{Expires}))."\n";print "LINE=".__LINE__."\n";
} else {
$return.="\n -- NO EXPIRATION IS SET --\n";print "LINE=".__LINE__."\n";
}
return $return;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $never_expires_sub=sub {
package neverexpires;print "LINE=".__LINE__."\n";
my $arg=']!P[{existing_plans}';print "LINE=".__LINE__."\n";
$arg=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
my $plan=&Net::FullAuto::FA_Core::getplan($arg);print "LINE=".__LINE__."\n";
my ($bdb,$dbenv)=&Net::FullAuto::FA_Core::openplandb();print "LINE=".__LINE__."\n";
my $cursor=$bdb->db_cursor();print "LINE=".__LINE__."\n";
my ($k,$v)=('','');print "LINE=".__LINE__."\n";
my $planhash='';print "LINE=".__LINE__."\n";
my $plan_number=$arg;print "LINE=".__LINE__."\n";
$plan_number=~s/^.*:\s+(\d+)\s+.*$/$1/;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
#print "WHAT IS K=$k<== and PLAN=$plan_number\n";print "LINE=".__LINE__."\n";
if ($k eq $plan_number) {
$v=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$planhash=eval $v;print "LINE=".__LINE__."\n";
$planhash->{'Title'}||='';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
$planhash->{'Expires'}='never';print "LINE=".__LINE__."\n";
my $put_plan=Data::Dump::Streamer::Dump($planhash)->Out();print "LINE=".__LINE__."\n";
my $status=$bdb->db_put($plan_number,$put_plan);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return '<';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $set_optional_expiration_sub=sub {
my %activate_or_disable_expiration=(
Name => 'activate_or_disable_expiration',
Item_1 => {
Text => 'Set New Expiration',
Result => \%ask_exp,
},
Item_2 => {
Text => 'Set to Never Expires',
Result => $never_expires_sub,
},
Banner => $get_expiration_sub,
);print "LINE=".__LINE__."\n";
return \%activate_or_disable_expiration;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $plan_options_sub=sub {
#my $choice=']P[';print "LINE=".__LINE__."\n";
#print "\n PLAN=$choice\n";<STDIN>;print "LINE=".__LINE__."\n";
my %plan_options=(
Name => 'plan_options',
Item_1 => {
Text => 'Set Optional Maximum Number of Invocations',
},
Item_2 => {
Text => 'Set Optional Expiration Date and/or Time',
Result => $set_optional_expiration_sub,
},
Item_3 => {
Text => 'Set Authorized Users of this Plan',
},
Banner => sub {
my $plan=']P[';print "LINE=".__LINE__."\n";
$plan=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " Choose an operation to perform".
" with\n\n PLAN: $plan"
},
);print "LINE=".__LINE__."\n";
return \%plan_options;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $change_existing_plan_sub=sub {
package change_existing_plan_sub;print "LINE=".__LINE__."\n";
my $choice="]S[{plan_existing}";print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
my ($plan_number,$planhash,$bdb,$dbenv)=('',''.'','');print "LINE=".__LINE__."\n";
($plan_number,$planhash,$bdb,$dbenv)=
&Net::FullAuto::FA_Core::getplan($choice);print "LINE=".__LINE__."\n";
if (-1<index $choice,'Delete') {
my $answer='';print "LINE=".__LINE__."\n";
while ($answer!~/^[yY|nN]$/) { last }
my $ch=$choice;print "LINE=".__LINE__."\n";
$ch=~s/Delete //s;print "LINE=".__LINE__."\n";
$ch=~s/["]//gs;print "LINE=".__LINE__."\n";
$ch=~s/\s\s+/ /gs;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n Are You Sure You want to DELETE\n\n",
" $ch? (y|N) ";print "LINE=".__LINE__."\n";
while ($answer!~/^[yY|nN]$/) {
$answer=<STDIN>;print "LINE=".__LINE__."\n";
chomp($answer);print "LINE=".__LINE__."\n";
last if $answer=~/^[yY|nN]$/;print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
if ($answer=~/^[yY]$/) {
my $status=$bdb->db_del($plan_number);print "LINE=".__LINE__."\n";
}
} elsif (-1<index $choice, 'Rename') {
$planhash->{'Expires'}='never';print "LINE=".__LINE__."\n";
print "\n\n\n Type New Name for Plan $plan_number: ";print "LINE=".__LINE__."\n";
my $newname=<STDIN>;print "LINE=".__LINE__."\n";
chomp($newname);print "LINE=".__LINE__."\n";
$planhash->{'Title'}=$newname;print "LINE=".__LINE__."\n";
$planhash=Data::Dump::Streamer::Dump($planhash)->Out();print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $status=$bdb->db_put($plan_number,$planhash);print "LINE=".__LINE__."\n";
} else {
$planhash->{'Expires'}='never';print "LINE=".__LINE__."\n";
print "GOING TO EXPORT\n";print "LINE=".__LINE__."\n";
}
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock(9361);print "LINE=".__LINE__."\n";
return '{plan_menu}<';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $plan_existing_sub=sub {
my %plan_existing=(
Name => 'plan_existing',
Item_1 => {
Text => 'Delete Plan: ]C[',
Convey => sub {
my $p=']P[';print "LINE=".__LINE__."\n";
$p=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return $p;print "LINE=".__LINE__."\n";
},
Result => $change_existing_plan_sub,
},
Item_2 => {
Text => 'Rename Plan: ]C[',
Convey => sub {
my $p=']P[';print "LINE=".__LINE__."\n";
$p=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return $p;print "LINE=".__LINE__."\n";
},
Result => $change_existing_plan_sub,
},
Item_3 => {
Text => 'Export Plan: ]C[',
Convey => sub {
my $p=']P[';print "LINE=".__LINE__."\n";
$p=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return $p;print "LINE=".__LINE__."\n";
},
Result => $change_existing_plan_sub,
},
Banner => sub {
my $p=']P[';print "LINE=".__LINE__."\n";
$p=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " Choose an operation to perform".
" with\n\n PLAN: $p"
},
);print "LINE=".__LINE__."\n";
return \%plan_existing;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $getplans_sub=sub {
my $plans=&Net::FullAuto::FA_Core::getplans();print "LINE=".__LINE__."\n";
if (-1<$#{$plans}) {
return $plans;print "LINE=".__LINE__."\n";
} else {
my $message="\n\n".
" _ _ ___ _____ ___ _ \n".
" | \\| |/ _ \\_ _| __| (_)\n".
" | .` | (_) || | | _| _ \n".
" |_|\\_|\\___/ |_| |___| (_) \n".
"\n\n".
" *NO* Plans have yet been 'made' with\n".
" this FullAuto installation.\n\n".
" To make a 'plan' use the --plan argument\n".
" in conjunction with the --code argument\n".
" invoked from the command line.\n\n".
" Example: fa --plan --code hello_world\n\n".
" Press ANY KEY to return to the Plan Menu\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines,$message;print "LINE=".__LINE__."\n";
alarm 120;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode('cbreak');print "LINE=".__LINE__."\n";
# Turn off controls keys
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';print "LINE=".__LINE__."\n";
$key = ReadKey(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');print "LINE=".__LINE__."\n";
return '{plan_menu}<';print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
my $generate_crontrab=sub {
package generate_crontrab;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use Digest::SHA qw(sha256_hex);print "LINE=".__LINE__."\n";
use Net::FullAuto::FA_Core;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $data='][[ "select_recurrent_minutes" '.
']|[ ]P[{select_recurrent_months} '.
']|[ ]P[{select_recurrent_weekdays} '.
']|[ ]P[{select_recurrent_days} '.
']|[ ]P[{select_recurrent_hours} '.
']|[ ]S[{select_recurrent_minutes} '.
']|[ ]P[{existing_plans} ]][';print "LINE=".__LINE__."\n";
$data=~s/^[]](.*)[[]$/$1/s;print "LINE=".__LINE__."\n";
$data=~s/\]\|\[/],[/g;print "LINE=".__LINE__."\n";
$data=~s/\];/]/g;print "LINE=".__LINE__."\n";
print "DATA=$data\n";print "LINE=".__LINE__."\n";
my $output=eval $data;print "LINE=".__LINE__."\n";
print "ERROR=$@\n" if $@;print "LINE=".__LINE__."\n";
print "OUTPUT=$output\n";<STDIN>;print "LINE=".__LINE__."\n";
my ($monthstring,$weekdaysstring,$daystring,
$hourstring,$minstring,$weekstring,$track)=
('','','','','','',0);print "LINE=".__LINE__."\n";
if (ref $output->[1] eq 'ARRAY') {
if ($#{$output->[1]}==11
|| -1<index $output->[1]->[0],'Every') {
$monthstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[1]}==0) {
$monthstring=$monthconv{$output->[1]->[0]};print "LINE=".__LINE__."\n";
} else {
my $cnt=$monthconv{$output->[1]->[0]};print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $month (@{$output->[1]}) {
unless ($cnt++==$monthconv{$month}) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$monthstring.=$monthconv{$month}.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$monthstring=$save_start.'-'.
$monthconv{$output->[1]->[$#{$output->[1]}]};print "LINE=".__LINE__."\n";
} else {
chop $monthstring;print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $output->[1],'Every') {
$monthstring='*';print "LINE=".__LINE__."\n";
} else {
$monthstring=$monthconv{$output->[1]};print "LINE=".__LINE__."\n";
}
if (ref $output->[2] eq 'ARRAY') {
if ($#{$output->[2]}==6
|| -1<index $output->[2]->[0],'Any') {
$weekdaysstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[2]}==0) {
my $day=$output->[2]->[0];print "LINE=".__LINE__."\n";
$day=~s/\s*$//;print "LINE=".__LINE__."\n";
print "DAY1=$day<==\n";print "LINE=".__LINE__."\n";
$weekdaysstring=$weekdaysconv{$day};print "LINE=".__LINE__."\n";
} else {
my $day=$output->[2]->[0];print "LINE=".__LINE__."\n";
$day=~s/\s*$//;print "LINE=".__LINE__."\n";
print "DAY2=$day\n";print "LINE=".__LINE__."\n";
my $cnt=$weekdaysconv{$day};print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $weekday (@{$output->[2]}) {
$weekday=~s/\s*$//;print "LINE=".__LINE__."\n";
unless ($cnt++==$weekdaysconv{$weekday}) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$weekdaysstring.=$weekdaysconv{$weekday}.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
print "FIVE={${$output->[2]}
[$#{$output->[2]}]\n";print "LINE=".__LINE__."\n";
my $day=$output->[2]->[$#{$output->[2]}];print "LINE=".__LINE__."\n";
$weekdaysstring=$save_start.'-'.
$weekdaysconv{$day};print "LINE=".__LINE__."\n";
} else {
chop $weekdaysstring;print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $output->[2],'Every') {
$weekdaysstring='*';print "LINE=".__LINE__."\n";
} else {
print "FOUR=$output->[2]\n";print "LINE=".__LINE__."\n";
my $day=$output->[2];print "LINE=".__LINE__."\n";
$day=~s/\s*$//;print "LINE=".__LINE__."\n";
$weekdaysstring=$weekdaysconv{$day};print "LINE=".__LINE__."\n";
}
if (ref $output->[3] eq 'ARRAY') {
if ($#{$output->[3]}==30
|| -1<index $output->[3]->[0],'Any') {
$daystring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[3]}==0) {
$daystring=unpack('x5 a*',$output->[3]->[0]);print "LINE=".__LINE__."\n";
} else {
my $cnt=unpack('x5 a*',$output->[3]->[0]);print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $day (@{$output->[3]}) {
$day=unpack('x5 a*',$day);print "LINE=".__LINE__."\n";
unless ($cnt++==$day) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$daystring.=$day.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$daystring=$save_start.'-'.
$output->[3]->[$#{$output->[3]}];print "LINE=".__LINE__."\n";
} else {
chop $daystring;print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $output->[3],'Every') {
$daystring='*';print "LINE=".__LINE__."\n";
} else {
$daystring=unpack('x5 a*',{$output->[3]});print "LINE=".__LINE__."\n";
}
if (ref $output->[4] eq 'ARRAY') {
if ($#{$output->[4]}==23
|| -1<index $output->[4]->[0],'Every') {
$hourstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[4]}==0) {
$hourstring=$hourconv{unpack('x6 a*',$output->[4]->[0])};print "LINE=".__LINE__."\n";
} else {
my $out=${$output->[4]}[0];print "LINE=".__LINE__."\n";
$out=~s/^.*Hour\s*(.*)$/$1/;print "LINE=".__LINE__."\n";
my $cnt=$hourconv{unpack('x6 a*',$out)};print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $hour (@{$output->[4]}) {
$hour=~s/^.*Hour\s*(.*)$/$1/;print "LINE=".__LINE__."\n";
unless ($cnt++==$hourconv{unpack('x6 a*',$hour)}) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$hourstring.=$hourconv{unpack('x6 a*',$hour)}.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$hourstring=$save_start.'-'.
$hourconv{unpack('x6 a*',
$output->[4]->[$#{$output->[4]}])};print "LINE=".__LINE__."\n";
} else {
chop $hourstring;print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $output->[4],'Every') {
$hourstring='*';print "LINE=".__LINE__."\n";
} else {
$hourstring=$hourconv{unpack('x6 a*',$output->[4])};print "LINE=".__LINE__."\n";
}
if (ref $output->[5] eq 'ARRAY') {
if ($#{$output->[5]}==59
|| -1<index $output->[5]->[0],'Every') {
$minstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[5]}==0) {
$minstring=unpack('x8 a*',$output->[5]->[0]);print "LINE=".__LINE__."\n";
} else {
my $cnt=unpack('x8 a*',$output->[5]->[0]);print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $minute (@{$output->[5]}) {
$minute=unpack('x8 a*',$minute);print "LINE=".__LINE__."\n";
unless ($cnt++==$minute) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$minstring.=$minute.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$minstring=$save_start.'-'.
$output->[5]->[$#{$output->[5]}];print "LINE=".__LINE__."\n";
} else {
chop $minstring;print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $output->[5],'Every') {
$minstring='*';print "LINE=".__LINE__."\n";
} else {
$minstring=unpack('x8 a*',$output->[5]);print "LINE=".__LINE__."\n";
}
my $planstring=$output->[6]->[0];print "LINE=".__LINE__."\n";
$planstring=~s/^Plan:\s*(\d+)\s+.*$/$1/;print "LINE=".__LINE__."\n";
print "WEEKDATS=$weekdaysstring<==\n";print "LINE=".__LINE__."\n";
my $cronstring=$minstring.' '.$hourstring.' '.$daystring.' '.
$monthstring.' '.$weekdaysstring;print "LINE=".__LINE__."\n";
print "CRONSTRING=$cronstring and PLANSTRING=$planstring<==\n";<STDIN>;print "LINE=".__LINE__."\n";
my $crontabpath=$Net::FullAuto::FA_Core::gbp->('crontab');print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=Net::FullAuto::FA_Core::cmd("${crontabpath}crontab -l");print "LINE=".__LINE__."\n";
print "WAHT IS CRONTABSTDOUT=$stdout and STDERR=$stderr\n";<STDIN>;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $fa_global::FA_Secure.'Jobs') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$fa_global::FA_Secure.'Jobs';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Jobs',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
my $filename=$Net::FullAuto::FA_Core::progname.'_jobs.db';print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => $filename,
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$fa_global::FA_Secure.'Jobs/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $cronentry="$cronstring /usr/local/bin/fa --login ".
"$username ".
"--password --plan $planstring";print "LINE=".__LINE__."\n";
if ($stderr && -1<index $stderr,'no crontab') {
my $dig=sha256_hex($cronentry);print "LINE=".__LINE__."\n";
print "DIG=$dig and CRONENTRY=$cronentry\n";print "LINE=".__LINE__."\n";
($stdout,$stderr)=Net::FullAuto::FA_Core::cmd(
$Net::FullAuto::FA_Core::gbp->('printf').
"printf \"# FullAuto Job: $dig\012".
$cronentry."\012\"".' | crontab -');print "LINE=".__LINE__."\n";
} elsif ($stdout=~/^\s*[^#].*$/m) {
my $line='';print "LINE=".__LINE__."\n";
my %fullauto_jobs=();print "LINE=".__LINE__."\n";
my %all_cron_entries=();print "LINE=".__LINE__."\n";
my %line_lookup=();print "LINE=".__LINE__."\n";
foreach my $line (split "\n", $stdout) {
if ($line=~/^\s*[#] FullAuto Job: (\S+)$/) {
$fullauto_jobs{$1}='';print "LINE=".__LINE__."\n";
} else {
print "UNCOMMENTED LINE=$line<==\n";print "LINE=".__LINE__."\n";
my $dig=sha256_hex($line);print "LINE=".__LINE__."\n";
$all_cron_entries{$dig}=$line;print "LINE=".__LINE__."\n";
$line_lookup{$line}=$dig;print "LINE=".__LINE__."\n";
}
#print "LINE=$line\n";print "LINE=".__LINE__."\n";
}
if (exists $line_lookup{$cronentry}
&& exists $fullauto_jobs{$line_lookup{$cronentry}}) {
print "FullAuto Cmd: $cronentry\nAlready exists as a job: $line_lookup{$cronentry}\n";<STDIN>;print "LINE=".__LINE__."\n";
}
#print "WE GOT CRON CONTENTS=$stdout<==\n";print "LINE=".__LINE__."\n";
}
return '{plan_menu}<';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my %select_recurrent_minutes=(
Name => 'select_recurrent_minutes',
Item_1 => {
Text => 'Every Minute of the Hour (*)',
Result => $generate_crontrab,
},
Item_2 => {
Text => "Minute ]C[",
#Select => 'Many',
Convey => [0..59],
Result => $generate_crontrab,
},
Select => 'Many',
Banner => sub {
my $plan="]P[{existing_plans}";print "LINE=".__LINE__."\n";
$plan=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " (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\n\n Will be Run :"
},
);print "LINE=".__LINE__."\n";
my %select_recurrent_hours=(
Name => 'select_recurrent_hours',
Item_1 => {
Text => 'Every Hour of the Day (*)',
Result => \%select_recurrent_minutes,
},
Item_2 => {
Text => 'Hour ]C[',
Convey => $hours,
Select => 'Many',
Result => \%select_recurrent_minutes,
},
Banner => sub {
my $plan="]P[{existing_plans}";print "LINE=".__LINE__."\n";
$plan=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " Select the --HOUR(S)-- of the Day Where\n\n ".
" $plan\n\n Will be Run :"
},
);print "LINE=".__LINE__."\n";
my %select_recurrent_days=(
Name => 'select_recurrent_days',
Item_1 => {
Text => "Any Day of the Month (*)\n".
" [Subject to Day of the Week selections]",
Result => \%select_recurrent_hours,
},
Item_2 => {
Text => 'Day ]C[',
Convey => [1..31],
Select => 'Many',
Result => \%select_recurrent_hours,
},
Banner => sub {
my $plan="]P[{existing_plans}";print "LINE=".__LINE__."\n";
$plan=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " Select the --DAY(S)-- of the Month Where\n\n ".
" $plan\n\n Will be Run :"
},
);print "LINE=".__LINE__."\n";
my %select_recurrent_weekdays=(
Name => 'select_recurrent_weekdays',
Item_1 => {
Text => "Any Day of the Week (*)\n".
" [Subject to Day of the Month selections]",
Result => \%select_recurrent_days,
},
Item_2 => {
Text => ']C[',
Convey => \@weekdays,
Select => 'Many',
Result => \%select_recurrent_days,
},
Banner => sub {
my $plan="]P[{existing_plans}";print "LINE=".__LINE__."\n";
$plan=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " Select the --WEEKDAY(S)-- Where\n\n ".
" $plan\n\n Will be Run :"
},
);print "LINE=".__LINE__."\n";
my %select_recurrent_months=(
Name => 'select_recurrent_months',
Item_1 => {
Text => 'Every Month of the Year (*)',
Result => \%select_recurrent_weekdays,
},
Item_2 => {
Text => ']C[',
Convey => \@month,
Select => 'Many',
Result => \%select_recurrent_weekdays,
},
Display => 6,
Banner => sub {
my $plan="]P[{existing_plans}";print "LINE=".__LINE__."\n";
$plan=~s/^["](.*)["]$/$1/s;print "LINE=".__LINE__."\n";
return " Select the --MONTH(S)-- where\n\n ".
" $plan\n\n Will be Run :"
},
);print "LINE=".__LINE__."\n";
my %select_min_for_invocation=(
Name => 'select_min_for_invocation',
Item_1 => {
Text => "]C[",
Convey => $showmins,
Result => sub{ return 'select_min_for_invocation '.
']P[{one_time_launch} '.
']S[ | ]P[{existing_plans}' }
},
Banner => " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Job Invocation Time :",
);print "LINE=".__LINE__."\n";
my %select_hour_for_invocation=(
Name => '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[{existing_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[ :",
);print "LINE=".__LINE__."\n";
my %select_cal_mins_for_plan=(
Name => '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[{existing_plans}' }
},
Banner => " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Job Invocation Time :",
);print "LINE=".__LINE__."\n";
my %select_cal_hours_for_plan=(
Name => '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[{existing_plans}' }
},
Banner => " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Job Invocation Time :",
);print "LINE=".__LINE__."\n";
my %select_cal_days_for_plan=(
Name => '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 :'
);print "LINE=".__LINE__."\n";
my %select_cal_months_for_plan=(
Name => 'select_cal_months_for_plan',
Item_1=> {
Text => "]C[",
Convey => $cal_months,
Result => \%select_cal_days_for_plan,
},
Banner => ' Please Select a Month :'
);print "LINE=".__LINE__."\n";
my %calendar_years_for_plan=(
Name => 'calendar_years_for_plan',
Item_1=> {
Text => "]C[",
Convey => [$curyear..$endyear],
Result => \%select_cal_months_for_plan,
},
Banner => ' Please Select a Year :'
);print "LINE=".__LINE__."\n";
my %one_time_launch=(
Name => '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[{existing_plans}",
);print "LINE=".__LINE__."\n";
my $select_type_of_scheduled_plan_sub=sub {
my %select_type_of_scheduled_plan=(
Name => '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 => sub {
my $choice=']P[';print "LINE=".__LINE__."\n";
$choice=~s/^"(.*)"$/$1/s;print "LINE=".__LINE__."\n";
return " Select Type of Scheduled Job for\n\n Plan: $choice";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%select_type_of_scheduled_plan;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $plan_options_work_with_sub=sub {
my $choice="]!T[{plan_menu}";print "LINE=".__LINE__."\n";
if ($choice eq '"Work with Existing Plans"') {
return $plan_existing_sub;print "LINE=".__LINE__."\n";
} elsif ($choice eq '"Set Up a New Scheduled Job"') {
return $select_type_of_scheduled_plan_sub;print "LINE=".__LINE__."\n";
} else {
return $plan_options_sub;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
my $plan_menu_options_sub=sub {
my $plans=&Net::FullAuto::FA_Core::getplans();print "LINE=".__LINE__."\n";
if (-1<$#{$plans}) {
my %existing_plans=(
Name => 'existing_plans',
Item_1=> {
Text => "Plan: ]C[",
Convey => $getplans_sub,
Result => $plan_options_work_with_sub,
},
Banner=> ' Select a Plan to work with:'
);print "LINE=".__LINE__."\n";
return \%existing_plans;print "LINE=".__LINE__."\n";
} else {
my $message="\n\n".
" _ _ ___ _____ ___ _ \n".
" | \\| |/ _ \\_ _| __| (_)\n".
" | .` | (_) || | | _| _ \n".
" |_|\\_|\\___/ |_| |___| (_) \n".
"\n\n".
" *NO* Plans have yet been 'made' with\n".
" this FullAuto installation.\n\n".
" To make a 'plan' use the --plan argument\n".
" in conjunction with the --code argument\n".
" invoked from the command line.\n\n".
" Example: fa --plan --code hello_world\n\n".
" Press ANY KEY to return to the Plan Menu\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines,$message;print "LINE=".__LINE__."\n";
alarm 120;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode('cbreak');print "LINE=".__LINE__."\n";
# Turn off controls keys
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';print "LINE=".__LINE__."\n";
$key = ReadKey(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');print "LINE=".__LINE__."\n";
return '<';print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
my $setup_new_sched_job_menu_sub=sub {
my %setup_new_sched_job_menu=(
Name => 'setup_new_sched_job_menu',
Item_1 => {
Text => 'Choose a FullAuto Plan to Schedule',
Result => $plan_menu_options_sub,
},
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',
);print "LINE=".__LINE__."\n";
return \%setup_new_sched_job_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my %plan_menu=(
Name => 'plan_menu',
Item_1 => {
Text => 'Accept Defaults and Record New Plan',
Result => sub {
unless (grep { /--plan/i } @ARGV) {
my $message="\n".
" ___ _ _ _ \n".
" |_ _|_ __ _ __ ___ _ _| |_ __ _ _ _| |_ | |\n".
" | || ' \\| '_ \\/ _ \\ '_| _/ _` | ' \\ _| |_|\n".
" |___|_|_|_| .__/\\___/_| \\__\\__,_|_||_\\__| (_)\n".
" |_|\n".
"\n".
" This selection is not available when accessed\n".
" via the Admin Menu. This item is available only\n".
" when the --plan argument is used in conjunction\n".
" with the --code argument invoked from the command\n".
" line.\n\n".
" Example: fa --plan --code hello_world\n\n".
" Press ANY KEY to return to the Plan Menu\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines,
$message;print "LINE=".__LINE__."\n";
alarm 120;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode('cbreak');print "LINE=".__LINE__."\n";
# Turn off controls keys
eval {
$SIG{ALRM} = sub { die "alarm\n" };print "LINE=".__LINE__."\n";
# \n required
my $key='';print "LINE=".__LINE__."\n";
$key = ReadKey(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');print "LINE=".__LINE__."\n";
return '<';print "LINE=".__LINE__."\n";
}
return ']S['
},
},
Item_2 => {
Text => 'Set Options for Plan',
Result => $plan_menu_options_sub,
},
Item_3 => {
Text => 'Set Up a New Scheduled Job',
Result => $setup_new_sched_job_menu_sub,
},
Item_4 => {
Text => 'Work with Existing Plans',
Result => $plan_menu_options_sub,
},
Item_5 => {
Text => 'Work with Existing Scheduled Jobs',
},
Banner =>
" ___ _ _ _ _ __ __ \n".
" | _ \\ |__ _ _ _ _| |_ _ | |___| |__ | \\/ |___ _ _ _ _ \n".
" | _/ / _` | ' \\ |_ _| | || / _ \\ '_ \\ | |\\/| / -_) ' \\ || |\n".
" |_| |_\\__,_|_||_| |_| \\__/\\___/_.__/ |_| |_\\___|_||_\\_,_|\n".
"\n".
" Plan: Indicated by a Plan Number, A FullAuto 'Plan' is a\n".
" recording of user &Menu() choices and user input.\n".
"\n".
" Job: A FullAuto Scheduled 'Job' is a fully unattended\n".
" invocation of a Custom Code Block via cron.",
);print "LINE=".__LINE__."\n";
my $plan_menu_sub = sub {
package plan_menu_sub;print "LINE=".__LINE__."\n";
use if (!defined $Net::FullAuto::FA_Core::localhost), 'Net::FullAuto';print "LINE=".__LINE__."\n";
our $fa_code='Net::FullAuto::FA_Core.pm';print "LINE=".__LINE__."\n";
unless (-1<index $Net::FullAuto::FA_Core::localhost,'=') {
$main::plan_menu_sub=1;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::fa_login();print "LINE=".__LINE__."\n";
undef $main::plan_menu_sub;print "LINE=".__LINE__."\n";
}
return \%plan_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
sub plan {
#print "PLANCALLER=",caller,"\n";print "LINE=".__LINE__."\n";
my $output=&Menu(\%plan_menu);print "LINE=".__LINE__."\n";
&cleanup() if $output=~/\]quit\[/i;print "LINE=".__LINE__."\n";
#print "WHAT IS OUTPUTFRESH=$output\n";print "LINE=".__LINE__."\n";
my $outp=join ' ', @{$output} if ref $output eq 'ARRAY';print "LINE=".__LINE__."\n";
print "OUTPUT=$outp\n" if defined $outp && $outp;print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
if ($output ne ']quit[') {
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $new_plan_number=0;print "LINE=".__LINE__."\n";
my ($k,$v) = ('','') ;print "LINE=".__LINE__."\n";
if (-1<index $output,'Accept Defaults and Record New Plan') {
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
my $status=$cursor->c_get($k, $v, DB_LAST);print "LINE=".__LINE__."\n";
$new_plan_number=++$k;print "LINE=".__LINE__."\n";
undef $cursor;print "LINE=".__LINE__."\n";
my $plann={ 'Number' =>$new_plan_number,
'Created'=>$Net::FullAuto::FA_Core::invoked[2],
'Creator'=>$username,
'Host' =>$Net::FullAuto::FA_Core::local_hostname,
'Expires'=>'never',
'Plan' =>[] };print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return $plann;print "LINE=".__LINE__."\n";
} elsif (-1<index $output,'Work with Existing Plans') {
my $plans=getplans($bdb);print "LINE=".__LINE__."\n";
if (-1<$#{$plans}) {
my %existing_plans=(
Name => 'existing_plans',
Item_1=> {
Text => "]C[",
Convey => $plans
},
Banner=> ' Select a Plan to work with:'
);print "LINE=".__LINE__."\n";
my $outp=Menu(\%existing_plans);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
undef $Net::FullAuto::FA_Core::makeplan;print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
} else {
print "\n\n ########################### NOTE ".
"###########################\n\n".
" *NO* Plans have been \"made\" with ".
"this FullAuto installation.\n\n";print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
}
} elsif (ref $output eq 'ARRAY' && $output->[0]
eq 'select_recurrent_minutes') {
my ($monthstring,$weekdaysstring,$daystring,
$hourstring,$minstring,$weekstring)=
('','','','','');print "LINE=".__LINE__."\n";
if (ref $output->[1] eq 'ARRAY') {
if ($#{$output->[1]}==11) {
$monthstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[1]}==0) {
$monthstring=$monthconv{${$output->[1]}[0]};print "LINE=".__LINE__."\n";
} else {
my $cnt=$monthconv{${$output->[1]}[0]};print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $month (@{$output->[1]}) {
unless ($cnt++==$monthconv{$month}) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$monthstring.=$monthconv{$month}.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$monthstring=$save_start.'-'.
$monthconv{${$output->[1]}
[$#{$output->[1]}]};print "LINE=".__LINE__."\n";
} else {
chop $monthstring;print "LINE=".__LINE__."\n";
}
}
} else {
$monthstring=$monthconv{$output->[1]};print "LINE=".__LINE__."\n";
}
if (ref $output->[2] eq 'ARRAY') {
if ($#{$output->[2]}==6) {
$weekdaysstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[2]}==0) {
$weekdaysstring=$weekdaysconv{${$output->[2]}[0]};print "LINE=".__LINE__."\n";
} else {
my $cnt=$weekdaysconv{${$output->[2]}[0]};print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $weekday (@{$output->[2]}) {
unless ($cnt++==$weekdaysconv{$weekday}) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$weekdaysstring.=$weekdaysconv{$weekday}.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$weekdaysstring=$save_start.'-'.
$weekdaysconv{${$output->[2]}
[$#{$output->[2]}]};print "LINE=".__LINE__."\n";
} else {
chop $weekdaysstring;print "LINE=".__LINE__."\n";
}
}
} else {
$weekdaysstring=$weekdaysconv{$output->[2]};print "LINE=".__LINE__."\n";
}
if (ref $output->[3] eq 'ARRAY') {
if ($#{$output->[3]}==30) {
$daystring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[3]}==0) {
$daystring=unpack('x5 a*',${$output->[3]}[0]);print "LINE=".__LINE__."\n";
} else {
my $cnt=unpack('x5 a*',${$output->[3]}[0]);print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $day (@{$output->[3]}) {
$day=unpack('x5 a*',$day);print "LINE=".__LINE__."\n";
unless ($cnt++==$day) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$daystring.=$day.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$daystring=$save_start.'-'.
${$output->[3]}[$#{$output->[3]}];print "LINE=".__LINE__."\n";
} else {
chop $daystring;print "LINE=".__LINE__."\n";
}
}
} else {
$daystring=unpack('x5 a*',{$output->[3]});print "LINE=".__LINE__."\n";
}
if (ref $output->[4] eq 'ARRAY') {
if ($#{$output->[4]}==23) {
$hourstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[4]}==0) {
$hourstring=$hourconv{${$output->[4]}[0]};print "LINE=".__LINE__."\n";
} else {
my $cnt=$hourconv{unpack('x6 a*',${$output->[4]}[0])};print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $hour (@{$output->[4]}) {
unless ($cnt++==$hourconv{unpack('x6 a*',$hour)}) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$hourstring.=$hourconv{unpack('x6 a*',$hour)}.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$hourstring=$save_start.'-'.
$hourconv{unpack('x6 a*',${$output->[4]}
[$#{$output->[4]}])};print "LINE=".__LINE__."\n";
} else {
chop $hourstring;print "LINE=".__LINE__."\n";
}
}
} else {
$hourstring=$hourconv{unpack('x6 a*',$output->[4])};print "LINE=".__LINE__."\n";
}
if (ref $output->[5] eq 'ARRAY') {
if ($#{$output->[5]}==59) {
$minstring='*';print "LINE=".__LINE__."\n";
} elsif ($#{$output->[5]}==0) {
$minstring=unpack('x8 a*',${$output->[5]}[0]);print "LINE=".__LINE__."\n";
} else {
my $cnt=unpack('x8 a*',${$output->[5]}[0]);print "LINE=".__LINE__."\n";
my $save_start=$cnt;print "LINE=".__LINE__."\n";
foreach my $minute (@{$output->[5]}) {
$minute=unpack('x8 a*',$minute);print "LINE=".__LINE__."\n";
unless ($cnt++==$minute) {
$save_start=-1;print "LINE=".__LINE__."\n";
}
$minstring.=$minute.',';print "LINE=".__LINE__."\n";
}
if (-1<$save_start) {
$minstring=$save_start.'-'.
${$output->[5]}[$#{$output->[5]}];print "LINE=".__LINE__."\n";
} else {
chop $minstring;print "LINE=".__LINE__."\n";
}
}
} else {
$minstring=unpack('x8 a*',$output->[5]);print "LINE=".__LINE__."\n";
}
my $planstring=$output->[6];print "LINE=".__LINE__."\n";
my $cronstring=$minstring.' '.$hourstring.' '.$daystring.' '.
$monthstring.' '.$weekdaysstring;print "LINE=".__LINE__."\n";
print "CRONSTRING=$cronstring\n";print "LINE=".__LINE__."\n";
our $crontabpath='';print "LINE=".__LINE__."\n";
if (-e '/usr/bin/crontab') {
$crontabpath='/usr/bin/';print "LINE=".__LINE__."\n";
} elsif (-e '/bin/crontab') {
$crontabpath='/bin/';print "LINE=".__LINE__."\n";
} elsif (-e '/usr/local/bin/crontab') {
$crontabpath='/usr/local/bin/';print "LINE=".__LINE__."\n";
}
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=cmd("${crontabpath}crontab -l");print "LINE=".__LINE__."\n";
#print "WAHT IS CRONTABSTDOUT=$stdout\n";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Jobs') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Jobs';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Jobs/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
if ($stderr && -1<index $stderr,'no crontab') {
$planstring=~tr/ //s;print "LINE=".__LINE__."\n";
my $plnn=$planstring;print "LINE=".__LINE__."\n";
$plnn=~s/^(\d+).*$/$1/;print "LINE=".__LINE__."\n";
my $dig=sha256_hex("$cronstring /usr/local/bin/fa --login ".
"$username --password --plan $plnn");print "LINE=".__LINE__."\n";
($stdout,$stderr)=cmd($Net::FullAuto::FA_Core::gbp->('printf').
"printf \"# FullAuto Plan $planstring \]|\[ $dig\012".
"$cronstring /usr/local/bin/fa --login $username ".
"--password --plan $plnn\012\"".'| crontab -');
} elsif ($stdout=~/^\s*[^#].*$/m) {
my $line='';print "LINE=".__LINE__."\n";
foreach my $line (split "\n", $stdout) {
if ($line=~/^\s*[#]/) {
next if (-1<index $line,'# DO NOT EDIT T');print "LINE=".__LINE__."\n";
next if $line=~/^# \(.* installed on /;print "LINE=".__LINE__."\n";
next if (-1<index $line,'# (Cron version');print "LINE=".__LINE__."\n";
print "COMMENTED LINE=$line\n";print "LINE=".__LINE__."\n";
my @plancom=split ' ',$line;print "LINE=".__LINE__."\n";
my $plnum='';my $chksum='';print "LINE=".__LINE__."\n";
#print "WHAT IS THIS=$plancom[$#plancom-2]\n";print "LINE=".__LINE__."\n";
if ($plancom[$#plancom-1] eq ']|[') {
$chksum=$plancom[$#plancom];print "LINE=".__LINE__."\n";
$plnum=$plancom[3];print "LINE=".__LINE__."\n";
}
#print "PLAN=$plnum and CHKSUM=$chksum\n";print "LINE=".__LINE__."\n";
} else {
print "UNCOMMENTED LINE=$line<==\n";print "LINE=".__LINE__."\n";
my $tesline=sha256_hex($line);print "LINE=".__LINE__."\n";
print "TESTLINE=$tesline<==\n";print "LINE=".__LINE__."\n";
}
#print "LINE=$line\n";print "LINE=".__LINE__."\n";
}
print "WE GOT CRON CONTENTS=$stdout<==\n";print "LINE=".__LINE__."\n";
}
print "STDOUTCRONT=$stdout<==\n";print "LINE=".__LINE__."\n";
print "STDERRCRONT=$stderr<==\n";print "LINE=".__LINE__."\n";
}
undef $Net::FullAuto::FA_Core::makeplan;print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
} else {
undef $Net::FullAuto::FA_Core::makeplan;print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
}
}
sub persist_get {
my $track='';print "LINE=".__LINE__."\n";
my $key=$_[0]||'';print "LINE=".__LINE__."\n";
&handle_error("Missing Arguements: ".
"&persist_get\(\[key\]\)")
unless $key;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
$key.='&';print "LINE=".__LINE__."\n";
$key.=join '&', caller;print "LINE=".__LINE__."\n";
$key.='&'.$Net::FullAuto::FA_Core::local_hostname.$username;print "LINE=".__LINE__."\n";
my $value='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($key,$value);print "LINE=".__LINE__."\n";
$value||='';print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return ($value,$key,$status);print "LINE=".__LINE__."\n";
}
sub persist_put {
my $key=$_[0]||'';print "LINE=".__LINE__."\n";
my $value=$_[1]||'';print "LINE=".__LINE__."\n";
&handle_error("Missing Arguements: ".
"&persist_put\(".
"\[key_returned_from_persist_get\],".
"\[string_to_persist\]\)")
unless $key && $value;print "LINE=".__LINE__."\n";
my $track='';print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $status=$bdb->db_put($key,$value);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return $status;print "LINE=".__LINE__."\n";
}
sub getplan {
my $plan=$_[0];print "LINE=".__LINE__."\n";
$plan=~s/^.*\s*Plan:\s+(\d+)\s+.*$/$1/;print "LINE=".__LINE__."\n";
my ($bdb,$dbenv)=openplandb();print "LINE=".__LINE__."\n";
my $cursor=$bdb->db_cursor();print "LINE=".__LINE__."\n";
my ($k,$v)=('','');print "LINE=".__LINE__."\n";
my $planhash='';print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
#print "WHAT IS K=$k<== and PLAN=$plan\n";print "LINE=".__LINE__."\n";
if ($k eq $plan) {
$v=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$planhash=eval $v;print "LINE=".__LINE__."\n";
$planhash->{'Title'}||='';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
return $plan,$planhash,$bdb,$dbenv if wantarray;print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return $planhash;print "LINE=".__LINE__."\n";
}
sub getplans {
my ($bdb,$dbenv)=openplandb();print "LINE=".__LINE__."\n";
my $cursor=$bdb->db_cursor();print "LINE=".__LINE__."\n";
my @plans=();print "LINE=".__LINE__."\n";
my ($k,$v)=('','');print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
$v=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
my $planhash=eval $v;print "LINE=".__LINE__."\n";
$planhash->{'Title'}||='';print "LINE=".__LINE__."\n";
push @plans, pack('A10',$k).$planhash->{'Title'};print "LINE=".__LINE__."\n";
}
undef $cursor;print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return \@plans;print "LINE=".__LINE__."\n";
}
sub sysreadline(*;$) {
my($handle, $timeout) = @_;print "LINE=".__LINE__."\n";
$handle = qualify_to_ref($handle, caller());print "LINE=".__LINE__."\n";
my $infinitely_patient = (@_ == 1 || $timeout < 0);print "LINE=".__LINE__."\n";
my $start_time = time();print "LINE=".__LINE__."\n";
my $selector = IO::Select->new();print "LINE=".__LINE__."\n";
$selector->add($handle);print "LINE=".__LINE__."\n";
my $line = '';print "LINE=".__LINE__."\n";
SLEEP:
until (at_eol($line)) {
unless ($infinitely_patient) {
return $line if time() > ($start_time + $timeout);print "LINE=".__LINE__."\n";
}
#sleep only 1 second before checking again
next SLEEP unless $selector->can_read(1.0);print "LINE=".__LINE__."\n";
INPUT_READY:
while ($selector->can_read(0.0)) {
my $was_blocking = $handle->blocking(0);print "LINE=".__LINE__."\n";
CHAR: while (sysread($handle, my $nextbyte, 1)) {
$line .= $nextbyte;print "LINE=".__LINE__."\n";
last CHAR if $nextbyte eq "\n";
}
$handle->blocking($was_blocking);print "LINE=".__LINE__."\n";
# if incomplete line, keep trying
next SLEEP unless at_eol($line);print "LINE=".__LINE__."\n";
last INPUT_READY;print "LINE=".__LINE__."\n";
}
}
return $line;print "LINE=".__LINE__."\n";
} sub at_eol($) { $_[0] =~ /\n\z/ }
sub acquire_fa_lock
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "acquire_fa_lock() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "acquire_fa_lock() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $lock_id=(defined $_[0] && $_[0])?$_[0]:'1234';print "LINE=".__LINE__."\n";
my $lock_description=(defined $_[1] && $_[1])?$_[1]:'';print "LINE=".__LINE__."\n";
my $cache=(defined $_[2] && $_[2])?$_[2]:'';print "LINE=".__LINE__."\n";
my $maxnumberallowed=(defined $_[3] && $_[3])?$_[3]:'';print "LINE=".__LINE__."\n";
my $killafterseconds=(defined $_[4] && $_[4])?$_[4]:'';print "LINE=".__LINE__."\n";
my $enable=(defined $_[5] && $_[5])?$_[5]:'';print "LINE=".__LINE__."\n";
my $wait_for_newlock=(defined $_[6] && $_[6])?$_[6]:'';print "LINE=".__LINE__."\n";
my $pollingmillisecs=(defined $_[7] && $_[7])?$_[7]:'';print "LINE=".__LINE__."\n";
my $locks='';my $getnewlock=0;my $newlock={};my $queue='';print "LINE=".__LINE__."\n";
my @letoct=split '', $lock_id;print "LINE=".__LINE__."\n";
my $letoct='';print "LINE=".__LINE__."\n";
foreach my $c (@letoct) {
if ($c=~/\d/) {
$letoct.=$c;print "LINE=".__LINE__."\n";
} else {
$enable=1 unless $enable;print "LINE=".__LINE__."\n";
$letoct.=ord($c);print "LINE=".__LINE__."\n";
}
}
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
unless ($Net::FullAuto::FA_Core::bdb_locks) {
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Locks') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Locks';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $ff=$Hosts{"__Master_${$}__"}{'FA_Secure'}."Locks/lock_$letoct.flag";print "LINE=".__LINE__."\n";
if (-e $ff) {
open (FF,"<$ff") || &handle_error("FATAL ERROR: Cannot open $ff");print "LINE=".__LINE__."\n";
my $db_info=<FF>||'';print "LINE=".__LINE__."\n";
close FF;print "LINE=".__LINE__."\n";
$db_info=~s/\s*$//;print "LINE=".__LINE__."\n";
my @db_info=split '|',$db_info||();print "LINE=".__LINE__."\n";
if (time>$db_info[1]+5) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Locks';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
unlink $ff;print "LINE=".__LINE__."\n";
}
}
$ENV{FA_ACQUIRING_BERKELEY_DB_LOCK}=$ff;print "LINE=".__LINE__."\n";
open (FF,">$ff") || &handle_error("FATAL ERROR: Cannot open $ff");print "LINE=".__LINE__."\n";
my $ltime=time +
$Net::FullAuto::FA_Core::locks->{$letoct}->{'KillAfterSeconds'};print "LINE=".__LINE__."\n";
print FF "$$|$ltime";print "LINE=".__LINE__."\n";
close FF;print "LINE=".__LINE__."\n";
unless ($Net::FullAuto::FA_Core::dbenv_locks) {
$Net::FullAuto::FA_Core::dbenv_locks = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Locks',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n");print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::dbenv_locks->set_flags(DB_CDB_ALLDB,1);print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::bdb_locks = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_locks.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $Net::FullAuto::FA_Core::dbenv_locks
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n");print "LINE=".__LINE__."\n";
unlink $ff;print "LINE=".__LINE__."\n";
delete $ENV{FA_ACQUIRING_BERKELEY_DB_LOCK};
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Locks/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
}
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_get($letoct,$locks);print "LINE=".__LINE__."\n";
my @processes=();print "LINE=".__LINE__."\n";
unless ($status) {
$locks=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$locks=eval $locks;print "LINE=".__LINE__."\n";
$queue=$locks->{'Queue'};print "LINE=".__LINE__."\n";
delete $locks->{'Queue'};
@processes=keys %{$locks};print "LINE=".__LINE__."\n";
}
if (-1<$#processes) {
$maxnumberallowed=$locks->{$processes[0]}->{'MaxNumberAllowed'}||1;print "LINE=".__LINE__."\n";
$killafterseconds=$locks->{$processes[0]}->{'KillAfterSeconds'}||0;print "LINE=".__LINE__."\n";
$enable=$locks->{$processes[0]}->{'Enable'}||0;print "LINE=".__LINE__."\n";
$lock_description=$locks->{$processes[0]}->{'Lock_Description'}||'';print "LINE=".__LINE__."\n";
$wait_for_newlock=$locks->{$processes[0]}->{'Wait_For_NewLock'}||60;print "LINE=".__LINE__."\n";
$pollingmillisecs=$locks->{$processes[0]}->{'PollingMilliSecs'}||500;print "LINE=".__LINE__."\n";
$newlock={
MaxNumberAllowed => $maxnumberallowed,
KillAfterSeconds => $killafterseconds,
Enable => $enable,
Lock_Description => $lock_description,
Wait_For_NewLock => $wait_for_newlock,
PollingMilliSecs => $pollingmillisecs,
};print "LINE=".__LINE__."\n";
#print "PROCESSES=@processes and $$\n";print "LINE=".__LINE__."\n";
if ($maxnumberallowed>$#processes+1) {
$getnewlock=1;print "LINE=".__LINE__."\n";
} else {
my $ps=$Net::FullAuto::FA_Core::gbp->('ps').'ps -e';print "LINE=".__LINE__."\n";
my ($psout,$pserr)=Net::FullAuto::FA_Core::cmd($ps);print "LINE=".__LINE__."\n";
my %pl=();print "LINE=".__LINE__."\n";
foreach my $line (split "\n", $psout) {
next unless -1<index $line,'perl';print "LINE=".__LINE__."\n";
my $pl=$line;print "LINE=".__LINE__."\n";
next unless -1<index $line,'perl';print "LINE=".__LINE__."\n";
$pl=~s/^I*\s+(\d+)\s+.*$/$1/;print "LINE=".__LINE__."\n";
$pl{$pl}='';print "LINE=".__LINE__."\n";
}
my @del_locks=();print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
foreach my $proc (@processes) {
my $process=$proc;print "LINE=".__LINE__."\n";
unless (exists $pl{$process}) {
push @del_locks, $process;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} elsif ($killafterseconds) {
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
my $t=time;print "LINE=".__LINE__."\n";
my $ta=$locks->{$process}->{'Time_LockAcquired'};print "LINE=".__LINE__."\n";
$ta+=$killafterseconds;print "LINE=".__LINE__."\n";
if ($t>$ta) {
($stdout,$stderr)=&kill($process,$kill_arg)
if &testpid($process);print "LINE=".__LINE__."\n";
push @del_locks, $process;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
}
if (-1<$#del_locks) {
foreach my $process (@del_locks) {
delete $locks->{$process};print "LINE=".__LINE__."\n";
}
if (-1==$#{[keys %{$locks}]}) {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_del(
$letoct);print "LINE=".__LINE__."\n";
} else {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_put(
$letoct,$locks);print "LINE=".__LINE__."\n";
}
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_get(
$letoct,$locks);print "LINE=".__LINE__."\n";
if ($status) {
$getnewlock=1;print "LINE=".__LINE__."\n";
} else {
$locks=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$locks=eval $locks;print "LINE=".__LINE__."\n";
$locks||={};print "LINE=".__LINE__."\n";
my @processes=keys %{$locks};print "LINE=".__LINE__."\n";
if ($maxnumberallowed>$#processes+1) {
$getnewlock=1;print "LINE=".__LINE__."\n";
}
}
}
my $expired_flag=0;print "LINE=".__LINE__."\n";
if (!$getnewlock) {
$locks->{$processes[0]}->{'Wait_For_NewLock'}||=60;print "LINE=".__LINE__."\n";
my $expires=time+$locks->{$processes[0]}->{'Wait_For_NewLock'};print "LINE=".__LINE__."\n";
my $p_length=length $pollingmillisecs;print "LINE=".__LINE__."\n";
my $polling=$pollingmillisecs;print "LINE=".__LINE__."\n";
if ($p_length==3) {
$polling="0.$polling";print "LINE=".__LINE__."\n";
} elsif ($p_length==2) {
$polling="0.0$polling";print "LINE=".__LINE__."\n";
} elsif ($p_length==1) {
$polling="0.00$polling";print "LINE=".__LINE__."\n";
} else {
$polling=~s/^(\d+)(\d\d\d)/$1.$2/;print "LINE=".__LINE__."\n";
}
my $pollcount=0;my $dotcount=0;print "LINE=".__LINE__."\n";
my @dots=('. ','. . ','. . . ');print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";print "LINE=".__LINE__."\n";
}
while (time<$expires) {
$dotcount=0 if 2<$dotcount;print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
STDOUT->autoflush(1);print "LINE=".__LINE__."\n";
printf("\r% 0s","Waiting for another process with lock ID ".
"[$lock_id] to finish (".$pollcount++.") ".
$dots[$dotcount]);print "LINE=".__LINE__."\n";
STDOUT->autoflush(0);print "LINE=".__LINE__."\n";
}
select(undef,undef,undef,$polling);print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'}, [0,
"Waiting for another process with lock ID [$lock_id] ".
"to finish (".$pollcount++.") $dots[$dotcount++]"])
if $cache;print "LINE=".__LINE__."\n";
$expired_flag=1;print "LINE=".__LINE__."\n";
$status=$Net::FullAuto::FA_Core::bdb_locks->db_get(
$letoct,$locks);print "LINE=".__LINE__."\n";
$locks=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$locks=eval $locks;print "LINE=".__LINE__."\n";
if ($status || $maxnumberallowed>$#{[keys %{$locks}]}+1) {
$expired_flag=0;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif ($letoct eq '9876') {
my $die="FATAL ERROR: FullAuto ACQUIRE Lock\n\n"
." Waiting period expired while waiting "
."for lock:\n\n $lock_description\n\n"
." Called by " . join ' ', @topcaller;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'}, [1,$die])
if $cache;print "LINE=".__LINE__."\n";
&handle_error($die);print "LINE=".__LINE__."\n";
}
}
}
if ($status || $expired_flag==0) {
$getnewlock=1;print "LINE=".__LINE__."\n";
} else {
my $max='';print "LINE=".__LINE__."\n";
if ($letoct==9876) {
$max=" Maximum Number Allowed => "
."$maxnumberallowed\n\n";print "LINE=".__LINE__."\n";
} else { print "\n" }
my $die="FATAL ERROR: FullAuto ACQUIRE Lock\n\n"
." Waiting period expired while waiting "
."for lock:\n\n $lock_description\n\n$max"
." Called by " . join ' ', @topcaller;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'}, [1,$die])
if $cache;print "LINE=".__LINE__."\n";
&handle_error($die);print "LINE=".__LINE__."\n";
}
}
} else {
$maxnumberallowed=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'MaxNumberAllowed'}
unless $maxnumberallowed;print "LINE=".__LINE__."\n";
$killafterseconds=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'KillAfterSeconds'}
unless $killafterseconds;print "LINE=".__LINE__."\n";
$enable=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'Enable'}
unless $enable;print "LINE=".__LINE__."\n";
$lock_description=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'Lock_Description'}
unless $lock_description;print "LINE=".__LINE__."\n";
$wait_for_newlock=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'Wait_For_NewLock'}
unless $wait_for_newlock;print "LINE=".__LINE__."\n";
$pollingmillisecs=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'PollingMilliSecs'}
unless $pollingmillisecs;print "LINE=".__LINE__."\n";
$newlock={
MaxNumberAllowed => $maxnumberallowed,
KillAfterSeconds => $killafterseconds,
Enable => $enable,
Lock_Description => $lock_description,
Wait_For_NewLock => $wait_for_newlock,
PollingMilliSecs => $pollingmillisecs,
UserName => $username,
Logfile => $Hosts{"__Master_${$}__"}{'LogFile'}
};print "LINE=".__LINE__."\n";
$getnewlock=1;print "LINE=".__LINE__."\n";
}
if ($getnewlock) {
return 0 if (!(exists $newlock->{'Enable'} &&
$newlock->{'Enable'}));print "LINE=".__LINE__."\n";
$newlock->{'FullAutoProcessID'}=$$;print "LINE=".__LINE__."\n";
$newlock->{'FA_ProcessInvoked'}=\@invoked;print "LINE=".__LINE__."\n";
$newlock->{'Time_LockAcquired'}=time;print "LINE=".__LINE__."\n";
if ($locks) {
$locks->{$$}=$newlock;print "LINE=".__LINE__."\n";
} else {
$locks={ $$, $newlock };print "LINE=".__LINE__."\n";
}
$newlock=Data::Dump::Streamer::Dump($locks)->Out();print "LINE=".__LINE__."\n";
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_put($letoct,$newlock);print "LINE=".__LINE__."\n";
return 1 unless $status;print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
}
}
sub release_fa_lock
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "release_fa_lock() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "release_fa_lock() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $lockid=(defined $_[0] && $_[0])?$_[0]:'1234';print "LINE=".__LINE__."\n";
my @letoct=split '', $lockid;print "LINE=".__LINE__."\n";
my $letoct='';print "LINE=".__LINE__."\n";
foreach my $c (@letoct) {
if ($c=~/\d/) {
$letoct.=$c;print "LINE=".__LINE__."\n";
} else {
$letoct.=ord($c);print "LINE=".__LINE__."\n";
}
}
my $locks='';print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::bdb_locks) {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_get($letoct,$locks);print "LINE=".__LINE__."\n";
if ($status) {
$Net::FullAuto::FA_Core::bdb_locks->db_del($letoct);print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
}
$locks=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$locks=eval $locks;print "LINE=".__LINE__."\n";
if (exists $locks->{$$}) {
delete $locks->{$$};print "LINE=".__LINE__."\n";
}
if (keys %{$locks}) {
$locks=Data::Dump::Streamer::Dump($locks)->Out();print "LINE=".__LINE__."\n";
$status=$Net::FullAuto::FA_Core::bdb_locks->db_put(
$letoct,$locks);print "LINE=".__LINE__."\n";
} else {
$status=$Net::FullAuto::FA_Core::bdb_locks->db_del(
$letoct);print "LINE=".__LINE__."\n";
}
}
return 0;print "LINE=".__LINE__."\n";
}
sub acquire_semaphore
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
my $sem='';print "LINE=".__LINE__."\n";
my $IPC_KEY=(defined $_[0] && $_[0])?$_[0]:'1234';print "LINE=".__LINE__."\n";
my $process_description=$_[1]||'';print "LINE=".__LINE__."\n";
my $pd="$process_description " if $process_description;print "LINE=".__LINE__."\n";
$pd||='';print "LINE=".__LINE__."\n";
print "acquire_semaphore() ${pd}CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "acquire_semaphore() ${pd}CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $semaphorecount=$_[2];print "LINE=".__LINE__."\n";
my $semaphore_count;print "LINE=".__LINE__."\n";
$semaphore_count=(defined $semaphorecount && 0<$semaphorecount) ?
$semaphorecount : 1;print "LINE=".__LINE__."\n";
&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;print "LINE=".__LINE__."\n";
my $semaphore_timeout=$_[3]||180;print "LINE=".__LINE__."\n";
if (0) {
#if ($^O eq 'cygwin') {
# try to open a semaphore
my $sem=Win32::Semaphore->open($IPC_KEY);print "LINE=".__LINE__."\n";
if (defined $sem && $sem) {
# wait for semaphore to be zero
my $previous='';print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
}
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($timeout-1);print "LINE=".__LINE__."\n";
my $stim=$semaphore_timeout * 1000;print "LINE=".__LINE__."\n";
$sem->wait($stim);print "LINE=".__LINE__."\n";
sleep 2;print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
&handle_error(("Win32 Semaphore Timed Out:\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');print "LINE=".__LINE__."\n";
}
} 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__');print "LINE=".__LINE__."\n";
}
}
# create a semaphore
--$semaphore_count if 1<$semaphore_count;print "LINE=".__LINE__."\n";
$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__');print "LINE=".__LINE__."\n";
} else {
# create a semaphore
unless ($IPC_KEY=~/^\d+$/) {
$IPC_KEY=sha256_hex($IPC_KEY);print "LINE=".__LINE__."\n";
$IPC_KEY=~s/[A-Z|a-z]//g;print "LINE=".__LINE__."\n";
$IPC_KEY=substr($IPC_KEY,0,4);print "LINE=".__LINE__."\n";
}
$sem = IPC::Semaphore->new($IPC_KEY,$semaphore_count,&S_IRWXU);print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
}
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($timeout-1);print "LINE=".__LINE__."\n";
# Decrement the semaphore count by 1
my $success=
$sem->op(0,-1,&SEM_UNDO);print "LINE=".__LINE__."\n";
# blocks if semaphore is zero
my $result = int $!; # capture the value of errno
$success||=0;$result||=0;print "LINE=".__LINE__."\n";
if (!$success && $result == &EINTR) {
die $result;print "LINE=".__LINE__."\n";
}
sleep 2;print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
&handle_error(("IPC Semaphore Timed Out:\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');print "LINE=".__LINE__."\n";
}
} 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__');print "LINE=".__LINE__."\n";
} else {
$sem->op(0,1,&SEM_UNDO);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=$sem;print "LINE=".__LINE__."\n";
}
}
} 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__');print "LINE=".__LINE__."\n";
$sem->op(0,1,&SEM_UNDO) if 1<$semaphore_count;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=$sem;print "LINE=".__LINE__."\n";
}
}
return $sem
}
sub test_semaphore
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "test_semaphore() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $IPC_KEY=$_[0];print "LINE=".__LINE__."\n";
$IPC_KEY||=1234;print "LINE=".__LINE__."\n";
my $opstring='';print "LINE=".__LINE__."\n";
my $opstring1='';print "LINE=".__LINE__."\n";
my $opstring2='';print "LINE=".__LINE__."\n";
my $semnum=0;print "LINE=".__LINE__."\n";
my $semop=0;print "LINE=".__LINE__."\n";
my $semflag=0;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
# try to open a semaphore
if (Win32::Semaphore->open($IPC_KEY)) {
return 1;print "LINE=".__LINE__."\n";
} else {
return 0;print "LINE=".__LINE__."\n";
}
} elsif (0) {
}
}
sub release_semaphore
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "release_semaphore() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $IPC_KEY=$_[0]||0;print "LINE=".__LINE__."\n";
my $semaphore_timeout=$_[1]||180;print "LINE=".__LINE__."\n";
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='';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->release(1,$previous);print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::semaphores{$IPC_KEY};print "LINE=".__LINE__."\n";
# 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);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->remove;print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::semaphores{$IPC_KEY};print "LINE=".__LINE__."\n";
# once past this point, any process waiting can proceed
}
}
}
sub kill
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::kill() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $pid=$_[0];my $arg=$_[1]||'';my $cmd=[];print "LINE=".__LINE__."\n";
my $stdout='';my $ignore='';print "LINE=".__LINE__."\n";
my $killpath=$Net::FullAuto::FA_Core::gbp->('kill');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'kill'}) {
$killpath=$Hosts{"__Master_${$}__"}{'kill'};print "LINE=".__LINE__."\n";
$killpath.='/' if $killpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $bashpath=$Net::FullAuto::FA_Core::gbp->('bash');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'bash'}) {
$bashpath=$Hosts{"__Master_${$}__"}{'bash'};print "LINE=".__LINE__."\n";
$bashpath.='/' if $bashpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'sed'}) {
$sedpath=$Hosts{"__Master_${$}__"}{'sed'};print "LINE=".__LINE__."\n";
$sedpath.='/' if $sedpath!~/\/$/;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
my $mystdout='';print "LINE=".__LINE__."\n";
IO::CaptureOutput::capture sub {
($ignore,$stdout)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
}, \$mystdout;print "LINE=".__LINE__."\n";
$stdout||='';print "LINE=".__LINE__."\n";
if (wantarray) {
return $stdout,'';print "LINE=".__LINE__."\n";
} else { return $stdout }
}
sub testpid
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::testpid() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $pid=$_[0];print "LINE=".__LINE__."\n";
if (!$pid) {
if (wantarray) {
return 0,'';print "LINE=".__LINE__."\n";
} else { return 0 }
}
my $killpath=$Net::FullAuto::FA_Core::gbp->('kill');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'kill'}) {
$killpath=$Hosts{"__Master_${$}__"}{'kill'};print "LINE=".__LINE__."\n";
$killpath.='/' if $killpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $bashpath=$Net::FullAuto::FA_Core::gbp->('bash');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'bash'}) {
$bashpath=$Hosts{"__Master_${$}__"}{'bash'};print "LINE=".__LINE__."\n";
$bashpath.='/' if $bashpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'sed'}) {
$sedpath=$Hosts{"__Master_${$}__"}{'sed'};print "LINE=".__LINE__."\n";
$sedpath.='/' if $sedpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
if ($^O ne 'cygwin') {
my $cmd=[ "${bashpath}bash",'-c',
"if ${killpath}kill -0 $pid"
." \012then echo 1\012else echo 0\012fi"
." | ${sedpath}sed -e \'s/^/stdout: /' 2>&1" ];print "LINE=".__LINE__."\n";
my $mystdout='';print "LINE=".__LINE__."\n";
IO::CaptureOutput::capture sub {
($stdout,$stderr)=&setuid_cmd($cmd,5); # Save Pound Sign
}, \$mystdout;print "LINE=".__LINE__."\n";
chomp $mystdout;print "LINE=".__LINE__."\n";
if ($mystdout=~s/^stdout: ?//) {
$stdout=$mystdout;print "LINE=".__LINE__."\n";
} elsif ($mystdout) {
$stderr=$mystdout;print "LINE=".__LINE__."\n";
}
} else {
my $cmd=[ "${bashpath}bash".' -c'
." \"if ${killpath}kill -0 $pid 2>/dev/null;"
." then echo 1; else echo 0; fi\""
.'|'."${sedpath}sed ".' -e '."\'s/^/stdout: /' ".'2>&1' ];print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if (wantarray) {
return $stdout, $stderr;print "LINE=".__LINE__."\n";
} elsif ($stdout) {
return $stdout;print "LINE=".__LINE__."\n";
} elsif ($stderr!~/^\s*$/) {
chomp($stderr=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
print "XXERROR=$stderr<== and CALLER=",caller,"<==\n";<STDIN>;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr);print "LINE=".__LINE__."\n";
} else { return $stdout }
}
sub get_master_info
{
my $Local_HostName='';my $Local_FullHostName='';print "LINE=".__LINE__."\n";
my $Local_IP_Address={};print "LINE=".__LINE__."\n";
$Local_HostName=(uname)[1];print "LINE=".__LINE__."\n";
$Local_HostName=&Sys::Hostname::hostname if !$Local_HostName;print "LINE=".__LINE__."\n";
my $addr='';print "LINE=".__LINE__."\n";
if ($^O ne 'cygwin') {
if ($Local_HostName!~/^localhost\.local/) {
$addr=gethostbyname($Local_HostName) ||
&handle_error(
"Couldn't Resolve Local Hostname $Local_HostName : ");print "LINE=".__LINE__."\n";
my $gip=sprintf "%vd", $addr;print "LINE=".__LINE__."\n";
# --CONTINUE-- print "WHAT IS GIP=$gip<==\n";print "LINE=".__LINE__."\n";
$same_host_as_Master{$gip}='-';print "LINE=".__LINE__."\n";
$Local_IP_Address->{$gip}='-';print "LINE=".__LINE__."\n";
$Local_FullHostName=gethostbyaddr($addr,AF_INET) ||
handle_error(
"Couldn't Re-Resolve Local Hostname $Local_HostName : ");print "LINE=".__LINE__."\n";
} else {
my $gip='127.0.0.1';print "LINE=".__LINE__."\n";
$same_host_as_Master{$gip}='-';print "LINE=".__LINE__."\n";
$Local_IP_Address->{$gip}='-';print "LINE=".__LINE__."\n";
$Local_FullHostName=$Local_HostName;print "LINE=".__LINE__."\n";
}
} else {
#my $route=cmd('cmd /c route print',3);print "LINE=".__LINE__."\n";
my $route=cmd('route print',3);print "LINE=".__LINE__."\n";
my $getip=0;print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $route) {
if (!$getip) {
if (-1<index $line, 'Metric') {
$getip=1;print "LINE=".__LINE__."\n";
} else { next }
} else {
my $gip=(split ' ', $line)[3];print "LINE=".__LINE__."\n";
next if !$gip;print "LINE=".__LINE__."\n";
next if -1==index $gip,'.';print "LINE=".__LINE__."\n";
$Local_IP_Address->{$gip}='-';
$same_host_as_Master{$gip}='-';print "LINE=".__LINE__."\n";
next if $gip=~/\d+\.0\.0\.1/;print "LINE=".__LINE__."\n";
}
}
}
$Local_FullHostName=$Local_HostName if !$Local_FullHostName;print "LINE=".__LINE__."\n";
$same_host_as_Master{$Local_HostName}='hostname';print "LINE=".__LINE__."\n";
$same_host_as_Master{$Local_FullHostName}='fullhostname';print "LINE=".__LINE__."\n";
return $Local_HostName,$Local_FullHostName,$Local_IP_Address;print "LINE=".__LINE__."\n";
}
sub check_Hosts
{
our ($Local_HostName,$Local_FullHostName,$Local_IP_Address)=
&get_master_info;print "LINE=".__LINE__."\n";
my $chk_hostname='';my $chk_ip='';my $trandir_flag='';print "LINE=".__LINE__."\n";
my $name=substr($_[0],0,-3);print "LINE=".__LINE__."\n";
$name=~s/^.*[\\|\/](.*)$/$1/;print "LINE=".__LINE__."\n";
my @Hosts=();print "LINE=".__LINE__."\n";
{
no warnings;print "LINE=".__LINE__."\n";
@Hosts=eval "\@${name}::Hosts";print "LINE=".__LINE__."\n";
}
my @Cycle=@Hosts;print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
HOST: foreach my $h (@Cycle) {
my $host=$h;print "LINE=".__LINE__."\n";
my $hostn='';my $ipn='';my $lh_key=0;print "LINE=".__LINE__."\n";
foreach my $keee (keys %{$host}) {
my $ke=$keee;print "LINE=".__LINE__."\n";
if (lc($ke) eq 'label' && lc($host->{$ke}) eq 'localhost') {
$lh_key=1;
} elsif (lc($ke) eq 'hostname') {
$hostn=$host->{$ke};print "LINE=".__LINE__."\n";
} elsif (lc($ke) eq 'ip') {
$ipn=$host->{$ke};print "LINE=".__LINE__."\n";
}
}
if ($hostn eq lc($Local_FullHostName)) {
$chk_hostname=$Local_FullHostName;print "LINE=".__LINE__."\n";
} elsif ($hostn eq lc($Local_HostName)) {
$chk_hostname=$Local_HostName;print "LINE=".__LINE__."\n";
} elsif (exists $Local_IP_Address->{$ipn}) {
$chk_ip=$ipn;print "LINE=".__LINE__."\n";
} elsif ($lh_key) {
} else { next }
if ($chk_hostname || $chk_ip || $lh_key==1) {
my $hash="\'Label\'=>\'__Master_${$}__\'\,";print "LINE=".__LINE__."\n";
$same_host_as_Master{$host->{'Label'}}='-';print "LINE=".__LINE__."\n";
foreach my $key (keys %{$host}) {
if (lc($key) eq 'sshport') {
next HOST;print "LINE=".__LINE__."\n";
} elsif (lc($key) eq 'label') {
if (lc($host->{$key}) eq 'localhost') {
$hash="\'Label\'=>\'__Master_${$}__\'\,";print "LINE=".__LINE__."\n";
foreach my $kee (keys %{$host}) {
if (lc($kee) eq 'label') {
next;print "LINE=".__LINE__."\n";
} 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}\'\,";print "LINE=".__LINE__."\n";
} else {
$hash.="\'SU_ID\'=>\'root\'\,";print "LINE=".__LINE__."\n";
} next;print "LINE=".__LINE__."\n";
} elsif (lc($kee) eq 'hostname' && !$chk_hostname) {
if (defined $Local_HostName) {
$hash.="\'HostName'=>\'".$Local_HostName."\'\,";print "LINE=".__LINE__."\n";
} elsif (defined $Local_FullHostName) {
$hash.="\'HostName'=>\'".$Local_FullHostName."\'\,";print "LINE=".__LINE__."\n";
} next;print "LINE=".__LINE__."\n";
} elsif (lc($kee) eq 'ip' && !$chk_hostname && keys
%{$Local_IP_Address}) {
$hash.="\'IP'=>\'".
(keys %{$Local_IP_Address})[0]."\'\,";print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} else {
$hash.="\'$kee'=>\'".$host->{$kee}."\'\,";print "LINE=".__LINE__."\n";
}
}
my $li_flag=0;my $hn_flag=0;my $ip_flag=0;print "LINE=".__LINE__."\n";
foreach my $ky (eval "\{ $hash \}") {
if (lc($ky) eq 'loginid' || lc($ky) eq 'login') {
$li_flag=1;print "LINE=".__LINE__."\n";
} elsif (lc($ky) eq 'hostname') {
$hn_flag=1;print "LINE=".__LINE__."\n";
} elsif (lc($ky) eq 'ip') {
$ip_flag=1;print "LINE=".__LINE__."\n";
}
}
$hash.="\'LoginID'=>\'".$username."\'\," unless $li_flag;print "LINE=".__LINE__."\n";
unless ($hn_flag) {
if (defined $Local_HostName) {
$hash.="\'HostName'=>\'".$Local_HostName."\'\,";print "LINE=".__LINE__."\n";
} elsif (defined $Local_FullHostName) {
$hash.="\'HostName'=>\'".$Local_FullHostName."\'\,";print "LINE=".__LINE__."\n";
}
}
unless ($ip_flag) {
if (keys %{$Local_IP_Address}) {
$hash.="\'IP'=>\'".
(keys %{$Local_IP_Address})[0]."\'\,";print "LINE=".__LINE__."\n";
}
}
$hash.="\'Uname'=>\'".(uname)[0]."\'\,";print "LINE=".__LINE__."\n";
my $has=eval "\{ $hash \}";print "LINE=".__LINE__."\n";
unshift @Hosts, $has;print "LINE=".__LINE__."\n";
next HOST;print "LINE=".__LINE__."\n";
} else {
next;print "LINE=".__LINE__."\n";
}
} 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';print "LINE=".__LINE__."\n";
next HOST;print "LINE=".__LINE__."\n";
} elsif ((lc(unpack('a1',$key)) eq 'l') && (lc($key) eq 'loginid'
|| lc($key) eq 'login') && $host->{$key} eq $username) {
next;print "LINE=".__LINE__."\n";
} elsif ($key eq 'SMB_Proxy'
|| $key eq 'RCM_Proxy'
|| $key eq 'FTM_Proxy') {
next;print "LINE=".__LINE__."\n";
} elsif (lc($key) eq 'hostName' && !$chk_hostname) {
if (defined $Local_HostName) {
$hash.="\'HostName'=>\'".$Local_HostName."\'\,";print "LINE=".__LINE__."\n";
} elsif (defined $Local_FullHostName) {
$hash.="\'HostName'=>\'".$Local_FullHostName."\'\,";print "LINE=".__LINE__."\n";
} next;print "LINE=".__LINE__."\n";
} elsif (lc($key) eq 'ip' && !$chk_hostname && keys
%{$Local_IP_Address}) {
$hash.="\'IP'=>\'".(keys %{$Local_IP_Address})[0]."\'\,";print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} elsif (lc($key) eq 'transferdir') {
$hash.="\'TransferDir'=>\'".${$host}{$key}."\'\,";print "LINE=".__LINE__."\n";
next HOST;print "LINE=".__LINE__."\n";
}
$hash.="\'$key'=>\'".${$host}{$key}."\'\,";print "LINE=".__LINE__."\n";
} $hash.="\'Uname'=>\'".(uname)[0]."\'\,";print "LINE=".__LINE__."\n";
unshift @Hosts, eval "\{ $hash \}";last;print "LINE=".__LINE__."\n";
}
}
if (!$chk_hostname && !$chk_ip) {
my $hostn='';my $ip='';print "LINE=".__LINE__."\n";
if ($Local_FullHostName) {
$hostn="\'HostName'=>\'$Local_FullHostName\'\,";print "LINE=".__LINE__."\n";
} elsif ($Local_HostName) {
$hostn="\'HostName'=>\'$Local_HostName\'\,";print "LINE=".__LINE__."\n";
}
if (keys %{$Local_IP_Address}) {
$ip="'IP'=>\'".(keys %{$Local_IP_Address})[0]."\',";print "LINE=".__LINE__."\n";
}
my $label="\'Label\'=>\'__Master_${$}__\',";print "LINE=".__LINE__."\n";
my $uname="'Uname'=>'".(uname)[0]."',";print "LINE=".__LINE__."\n";
my $local="'Local'=>'connect_ssh_telnet',";print "LINE=".__LINE__."\n";
my $remote="'Remote'=>'connect_host',";print "LINE=".__LINE__."\n";
unshift @Hosts,
eval "\{ $ip$hostn$label$uname$local$remote \}";print "LINE=".__LINE__."\n";
} return \@Hosts;print "LINE=".__LINE__."\n";
}
$Hosts{"__Master_${$}__"}{'HostName'}=&Sys::Hostname::hostname if
!exists $Hosts{"__Master_${$}__"}{'HostName'};print "LINE=".__LINE__."\n";
$Hosts{"__Master_${$}__"}{'IP'}='' if
!exists $Hosts{"__Master_${$}__"}{'IP'};print "LINE=".__LINE__."\n";
if (!exists $Hosts{"__Master_${$}__"}{'Cipher'}) {
$Hosts{"__Master_${$}__"}{'Cipher'}='DES';print "LINE=".__LINE__."\n";
} else {
eval "require " . $Hosts{"__Master_${$}__"}{'Cipher'};print "LINE=".__LINE__."\n";
&handle_error($@) if $@;print "LINE=".__LINE__."\n";
}
#sub check_Maps
#{
# foreach my $map (@fa_maps::Maps) {
# my $RCM_map=(exists ${$map}{'RCM'})?lc(${$map}{'RCM'}):'';print "LINE=".__LINE__."\n";
# my $FCM_map=(exists ${$map}{'FCM'})?${$map}{'FCM'}:'';print "LINE=".__LINE__."\n";
# }
# unshift @fa_maps::Maps, eval "\{ $map \}";last;print "LINE=".__LINE__."\n";
# unshift @fa_maps::Maps, eval "\{ $map \}";last;print "LINE=".__LINE__."\n";
#}
my %msproxies=();my %uxproxies=();my %labels=();print "LINE=".__LINE__."\n";
my %DeploySMB_Proxy=();my %DeployFTM_Proxy=();print "LINE=".__LINE__."\n";
my %DeployRCM_Proxy=();my $msflag='';my $uxflag='';print "LINE=".__LINE__."\n";
sub host_hash
{
foreach my $host (@{$_[0]}) {
$host->{'Label'}||='';print "LINE=".__LINE__."\n";
if (exists $labels{$host->{'Label'}} &&
($host->{'Label'} ne "__Master_${$}__")) {
&handle_error("DUPLICATE LABEL DETECTED - $host->{'Label'}");print "LINE=".__LINE__."\n";
} $labels{${$host}{'Label'}}='' if $host->{'Label'};print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
&handle_error($die);print "LINE=".__LINE__."\n";
} else {
$msproxies{${$host}{'SMB_Proxy'}}
=["${$host}{'SMB_Proxy'}",'SMB_Proxy'];print "LINE=".__LINE__."\n";
}
}
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");print "LINE=".__LINE__."\n";
} else {
$uxproxies{${$host}{'RCM_Proxy'}}
=["${$host}{'RCM_Proxy'}",'RCM_Proxy'];print "LINE=".__LINE__."\n";
}
}
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");print "LINE=".__LINE__."\n";
} else {
$uxproxies{${$host}{'FTM_Proxy'}}
=[${$host}{'FTM_Proxy'},'FTM_Proxy'];print "LINE=".__LINE__."\n";
}
}
foreach my $key (keys %{$host}) {
${$Hosts{${$host}{'Label'}}}{$key}=${$host}{$key};print "LINE=".__LINE__."\n";
if ($key eq 'SMB_Proxy') {
if (exists $same_host_as_Master{${$host}{'Label'}}) {
if (${$host}{'SMB_Proxy'}=~/^(\d+)$/) {
$DeploySMB_Proxy{${$host}{'SMB_Proxy'}}
="__Master_${$}__";print "LINE=".__LINE__."\n";
} 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'};print "LINE=".__LINE__."\n";
} 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_${$}__";print "LINE=".__LINE__."\n";
} 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'};print "LINE=".__LINE__."\n";
} 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_${$}__";print "LINE=".__LINE__."\n";
} 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'};print "LINE=".__LINE__."\n";
} else { push @DeployFTM_Proxy, ${$host}{'Label'} }
}
}
}
}
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 '/';print "LINE=".__LINE__."\n";
$Hosts{"__Master_${$}__"}{'FA_Secure'}=
$Hosts{$key}{'FA_Secure'};print "LINE=".__LINE__."\n";
last
}
}
if (!exists $Hosts{"__Master_${$}__"}{'FA_Secure'}) {
unless (-d '/var/db/Berkeley/FullAuto') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
unless (-d '/var/db') {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.'/var/db';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d '/var/db/Berkeley') {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.'/var/db/Berkeley';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d '/var/db/Berkeley/FullAuto') {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.'/var/db/Berkeley/FullAuto';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
}
if (!(-d '/var/db/Berkeley/FullAuto' && -w _)) {
&handle_error("Cannot Write to Berkeley FullAuto Directory :".
"\n\n ".
'/var/db/Berkeley/FullAuto');print "LINE=".__LINE__."\n";
}
$Hosts{"__Master_${$}__"}{'FA_Secure'}=
'/var/db/Berkeley/FullAuto/';print "LINE=".__LINE__."\n";
} elsif (!(-d $Hosts{"__Master_${$}__"}{'FA_Secure'} && -w _)) {
handle_error("Cannot Write to Berkeley FullAuto Directory :".
"\n\n ".
$Hosts{"__Master_${$}__"}{'FA_Secure'});print "LINE=".__LINE__."\n";
} else {
$Hosts{"__Master_${$}__"}{'FA_Secure'}.='/' if
substr($Hosts{"__Master_${$}__"}{'FA_Secure'},-1) ne '/';print "LINE=".__LINE__."\n";
}
my $FA_Core_path='';print "LINE=".__LINE__."\n";
foreach my $key (keys %INC) {
if (-1<index $key,'FA_Core.pm') {
$FA_Core_path=substr($INC{$key},0,(rindex $INC{$key},'/')+1);print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} $Hosts{"__Master_${$}__"}{'FA_Core'}=$FA_Core_path;print "LINE=".__LINE__."\n";
}
&host_hash(\@Hosts);print "LINE=".__LINE__."\n";
if (keys %DeploySMB_Proxy) {
foreach my $key (reverse sort keys %DeploySMB_Proxy) {
unshift @DeploySMB_Proxy, $DeploySMB_Proxy{$key};print "LINE=".__LINE__."\n";
}
}
if (keys %DeployRCM_Proxy) {
foreach my $key (reverse sort keys %DeployRCM_Proxy) {
unshift @DeployRCM_Proxy, $DeployRCM_Proxy{$key};print "LINE=".__LINE__."\n";
}
}
if (keys %DeployFTM_Proxy) {
foreach my $key (reverse sort keys %DeployFTM_Proxy) {
unshift @DeployFTM_Proxy, $DeployFTM_Proxy{$key};print "LINE=".__LINE__."\n";
}
}
my $ps_stdout=&cmd($Net::FullAuto::FA_Core::gbp->('ps').'ps');print "LINE=".__LINE__."\n";
sub get_all_hosts
{
return keys %Hosts;print "LINE=".__LINE__."\n";
}
sub connect_sftp
{
push @_, '__sftp__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_ftp
{
push @_, '__ftp__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_ftp_sftp
{
push @_, '__ftp_sftp__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_sftp_ftp
{
push @_, '__sftp_ftp__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_ssh
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "connect_ssh() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
push @_, '__ssh__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_ssh_telnet
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "connect_ssh-telnet() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
push @_, '__ssh_telnet__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n";print "LINE=".__LINE__."\n";
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n";print "LINE=".__LINE__."\n";
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n";print "LINE=".__LINE__."\n";
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_telnet_ssh
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "connect_ssh-telnet() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
push @_, '__telnet_ssh__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n";print "LINE=".__LINE__."\n";
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n";print "LINE=".__LINE__."\n";
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n";print "LINE=".__LINE__."\n";
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_secure
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "connect_secure() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
push @_, '__secure__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_insecure
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "connect_insecure() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
push @_, '__insecure__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n";print "LINE=".__LINE__."\n";
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n";print "LINE=".__LINE__."\n";
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n";print "LINE=".__LINE__."\n";
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_telnet
{
push @_, '__telnet__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_reverse
{
push @_, '__reverse__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_mozrepl
{
unless (defined $_[0] && $_[0]) {
}
push @_, '__telnet__';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
my $shell=$handle->{_shell};print "LINE=".__LINE__."\n";
if (defined $Net::FullAuto::FA_Core::ff_flag) {
foreach my $n (1..30) {
my $loc=$handle->repl("$shell.whereAmI()");print "LINE=".__LINE__."\n";
last if -1<index $loc,'FullAuto Software';print "LINE=".__LINE__."\n";
if ($n==5 || $n==10 || $n==15) {
my $go_to='content.document.location.href='.
'"http://www.fullautosoftware.net"';print "LINE=".__LINE__."\n";
my ($out,$error)=$handle->repl($go_to);print "LINE=".__LINE__."\n";
}
sleep 1;print "LINE=".__LINE__."\n";
}
}
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_cmd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::connect_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my ($handle,$stderr)=('','');print "LINE=".__LINE__."\n";
($handle,$stderr)=connect_host(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $handle,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');print "LINE=".__LINE__."\n";
} else {
return $handle;print "LINE=".__LINE__."\n";
}
}
sub connect_host
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::connect_host() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $caller=(caller(1))[3];print "LINE=".__LINE__."\n";
substr($caller,0,(index $caller,'::')+2)='';print "LINE=".__LINE__."\n";
my $sub='';my $_connect='connect_host';my $cache='';print "LINE=".__LINE__."\n";
my $hostlabel=$_[0];print "LINE=".__LINE__."\n";
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')
|| (-1<index $caller,'connect_mozrepl')) {
my $connect_caller=$caller;print "LINE=".__LINE__."\n";
$_connect=(split '::', $caller)[2];print "LINE=".__LINE__."\n";
($caller,$sub)=split '::', (caller(2))[3];print "LINE=".__LINE__."\n";
$caller.='.pm';print "LINE=".__LINE__."\n";
if ((-1<index $connect_caller,'connect_mozrepl') &&
(($_[0] eq '__telnet__') ||
(-1<index $_[0],'Moose::Meta::Class::__ANON__::SERIAL')
|| (-1<index $_[0],'Cache::FileCache'))) {
$hostlabel='Firefox MozRepl';print "LINE=".__LINE__."\n";
$Hosts{$hostlabel}{'HostName'}='localhost';print "LINE=".__LINE__."\n";
$Hosts{$hostlabel}{'Label'}=$hostlabel;print "LINE=".__LINE__."\n";
$Hosts{$hostlabel}{'telnetport'}=4242;print "LINE=".__LINE__."\n";
$_connect='connect_telnet';print "LINE=".__LINE__."\n";
}
} else {
my @called=caller(2);print "LINE=".__LINE__."\n";
if ((-1<index $caller,'mirror') || (-1<index $caller,'login_retry')) {
$sub=$called[3]
} else {
$caller=$called[3];print "LINE=".__LINE__."\n";
$caller=(caller(0))[0] if $caller=~/[(]eval[)]/;print "LINE=".__LINE__."\n";
$called[6]||='';print "LINE=".__LINE__."\n";
$sub=($called[6])?$called[6]:$called[3];print "LINE=".__LINE__."\n";
$sub=~s/^.*:://;print "LINE=".__LINE__."\n";
} $sub=~s/\s*\;\n*//
}
$Net::FullAuto::FA_Core::cltimeout||='X';print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$timeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (defined $_[1] && $_[1]=~/^[1-9]+/) {
$timeout=$_[1];print "LINE=".__LINE__."\n";
} elsif (defined $_[1] && (-1<index $_[1],'Cache::FileCache')) {
$cache=$_[1];print "LINE=".__LINE__."\n";
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;print "LINE=".__LINE__."\n";
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");print "LINE=".__LINE__."\n";
}
}
} elsif (defined $_[1] &&
(-1<index $_[1],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[1]->chi_root_class)) {
$cache=$_[1];print "LINE=".__LINE__."\n";
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;print "LINE=".__LINE__."\n";
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");print "LINE=".__LINE__."\n";
}
}
} elsif ((-1==index $caller,'mirror') &&
(-1==index $caller,'login_retry')) {
my $time_out='$' . (caller)[0] . '::timeout';print "LINE=".__LINE__."\n";
$time_out= eval $time_out;print "LINE=".__LINE__."\n";
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;print "LINE=".__LINE__."\n";
} else { $timeout=$time_out }
} else { print "FOUR\n";$timeout=30 }
if (defined $_[2] && lc($_[2]) ne '__telnet__' && lc($_[2]) ne '__ftp__') {
$Net::FullAuto::FA_Core::test=$_[2];print "LINE=".__LINE__."\n";
} elsif (defined $_[2] && (-1<index $_[2],'Cache::FileCache')) {
$cache=$_[2];print "LINE=".__LINE__."\n";
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;print "LINE=".__LINE__."\n";
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");print "LINE=".__LINE__."\n";
}
}
} elsif (defined $_[2] &&
(-1<index $_[2],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[2]->chi_root_class)) {
$cache=$_[2];print "LINE=".__LINE__."\n";
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;print "LINE=".__LINE__."\n";
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");print "LINE=".__LINE__."\n";
}
}
} else {
my $tst='$' . (caller)[0] . '::test';print "LINE=".__LINE__."\n";
$tst= eval $tst;print "LINE=".__LINE__."\n";
$tst||=0;print "LINE=".__LINE__."\n";
if ($@ || $tst!~/^[1-9]+/) {
$Net::FullAuto::FA_Core::test=0;print "LINE=".__LINE__."\n";
} else { $Net::FullAuto::FA_Core::test=$tst }
}
if (!$cache && $main::cache) {
$cache=$main::cache;print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
my $new_handle='';my $stderr='';print "LINE=".__LINE__."\n";
if ($_connect eq 'connect_ssh'
|| $_connect eq 'connect_telnet') {
($new_handle,$stderr)=new Rem_Command($hostlabel,
'__new_master__',$_connect,$cache);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
} else {
($new_handle,$stderr)=new File_Transfer($hostlabel,
'__new_master__',$_connect,$cache);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
}
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNING1\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $new_handle,$stderr;print "LINE=".__LINE__."\n";
} elsif (!$stderr) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNING2\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $new_handle;print "LINE=".__LINE__."\n";
} else {
print $Net::FullAuto::FA_Core::MRLOG "DIEINGNOWHERE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
sub cache
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::cache() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::cache() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $caller=(caller(1))[3];print "LINE=".__LINE__."\n";
substr($caller,0,(index $caller,'::')+2)='';print "LINE=".__LINE__."\n";
my $hostlabel=$_[0];print "LINE=".__LINE__."\n";
my $path_to_cache_root=$_[1]||$master_transfer_dir;print "LINE=".__LINE__."\n";
my $namespace=$_[2]||&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my @called=caller(2);print "LINE=".__LINE__."\n";
$caller=$called[3];print "LINE=".__LINE__."\n";
$caller=(caller(0))[0] if $caller=~/[(]eval[)]/;print "LINE=".__LINE__."\n";
$called[6]||='';print "LINE=".__LINE__."\n";
my $sub=($called[6])?$called[6]:$called[3];print "LINE=".__LINE__."\n";
$sub=~s/^.*:://;print "LINE=".__LINE__."\n";
$sub=~s/\s*\;\n*//;print "LINE=".__LINE__."\n";
if ($hostlabel) {
unless (exists $Hosts{$hostlabel}) {
my $die="\n FATAL ERROR - The First Argument to "
."&cache()\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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
unless (exists $Hosts{$hostlabel}->{Cache}) {
my $die="\n FATAL ERROR - There is no defined 'Cache'"
."item for\n -> \"$hostlabel"
."\"\n Called from the User Defined "
."Subroutine\n -> \&$sub\n "
." in the \"Custom Code\" module file"
."\n -> $caller\n\n"
." Be sure there is a Valid Cache => sub { ... },"
." item/element in the Host Block labeled "
."$hostlabel\n"
." -> $Net::FullAuto::FA_Core::fa_host .\n\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
unless (ref $Hosts{$hostlabel}->{Cache} eq 'CODE') {
my @called=caller(2);print "LINE=".__LINE__."\n";
$caller=$called[3];print "LINE=".__LINE__."\n";
$caller=(caller(0))[0] if $caller=~/[(]eval[)]/;print "LINE=".__LINE__."\n";
$called[6]||='';print "LINE=".__LINE__."\n";
my $die="\n FATAL ERROR - The 'Cache' item/element "
."for\n -> \"$hostlabel"
."\"\n Called from the User Defined "
."Subroutine\n -> \&$sub\n "
." in the \"Custom Code\" module file"
."\n -> $caller\n\n"
." is not a valid reference\n"
." to an anonymous subroutine:\n\n"
." Example: Cache => sub { ... },\n\n"
." in the Host Block labeled $hostlabel\n"
." -> $Net::FullAuto::FA_Core::fa_host .\n\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
if (exists $Hosts{$hostlabel} and exists $Hosts{$hostlabel}->{Cache}) {
return $Hosts{$hostlabel}->{Cache}->($path_to_cache_root,$namespace);print "LINE=".__LINE__."\n";
} elsif ($main::cache) {
return $main::cache;print "LINE=".__LINE__."\n";
}
}
sub memnow
{
my $stdout='';my $stderr='';my $all=0;print "LINE=".__LINE__."\n";
$all=1 if $_[0] && grep { /__all__/i } @_;print "LINE=".__LINE__."\n";
if ($_[0] && ref $_[0] eq 'HASH') {
if ($^O eq 'cygwin') {
($stdout,$stderr)=&Net::FullAuto::FA_Core::cmd(
$_[0],"cat /proc/meminfo");print "LINE=".__LINE__."\n";
&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");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__')
if $stderr && !wantarray
}
}
if (!$all && $^O eq 'cygwin') {
my $cnt=0;print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $stdout) {
next if !$cnt++;print "LINE=".__LINE__."\n";
$stdout=substr($line,(rindex $line,' ')+1,-1);print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
if (wantarray) {
return $stdout, $stderr;print "LINE=".__LINE__."\n";
} else {
return $stdout;print "LINE=".__LINE__."\n";
}
}
sub handle_error
{
#my $logreset=1;print "LINE=".__LINE__."\n";
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "FA_Core::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "FA_Core::handle_error() CALLER=",
(join ' ',@topcaller),"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
#$Net::FullAuto::FA_Core::log=0 if $logreset;print "LINE=".__LINE__."\n";
my $return=0;print "LINE=".__LINE__."\n";
my $line_adjust=0;my $warn=0;print "LINE=".__LINE__."\n";
my $error=$_[0];my $track='';print "LINE=".__LINE__."\n";
my $cleanup=0;print "LINE=".__LINE__."\n";
my $mail='';my $new_invoked='';print "LINE=".__LINE__."\n";
if (defined $_[1] && $_[1]) {
if (ref $_[1] eq 'HASH') {
$mail=$_[1];print "LINE=".__LINE__."\n";
} elsif (ref $_[1] eq 'ARRAY') {
$track=$_[1];print "LINE=".__LINE__."\n";
} else {
if ($_[1] eq '__cleanup__') {
$cleanup=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__return__') {
$return=$_[1];print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__warn__') {
$warn=1;print "LINE=".__LINE__."\n";
} elsif ($_[1]=~/^\s*-(\d+)\s*$/) {
$line_adjust=-$1;print "LINE=".__LINE__."\n";
} else {
print "ARG1 is NOT recognized\n==>$_[1]<==\n";print "LINE=".__LINE__."\n";
}
}
}
if (defined $_[2] && $_[2]) {
if (ref $_[2] eq 'HASH') {
$mail=$_[2];print "LINE=".__LINE__."\n";
} elsif (ref $_[2] eq 'ARRAY') {
$track=$_[2];print "LINE=".__LINE__."\n";
} else {
if ($_[2] eq '__cleanup__') {
$cleanup=1;print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__return__') {
$return=$_[2];print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__warn__') {
$warn=1;print "LINE=".__LINE__."\n";
} elsif ($_[2]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;print "LINE=".__LINE__."\n";
} else {
print "ARG2 is NOT recognized\n==>$_[2]<==\n";print "LINE=".__LINE__."\n";
}
}
}
if (defined $_[3] && $_[3]) {
if (ref $_[3] eq 'HASH') {
$mail=$_[3];print "LINE=".__LINE__."\n";
} elsif (ref $_[3] eq 'ARRAY') {
$track=$_[3];print "LINE=".__LINE__."\n";
} else {
if ($_[3] eq '__cleanup__') {
$cleanup=1;print "LINE=".__LINE__."\n";
} elsif ($_[3] eq '__return__') {
$return=$_[3];print "LINE=".__LINE__."\n";
} elsif ($_[3] eq '__warn__') {
$warn=1;print "LINE=".__LINE__."\n";
} elsif ($_[3]=~/^-(\d+)/) {
$line_adjust=-$1;print "LINE=".__LINE__."\n";
} else {
print "ARG3 is NOT recognized\n==>$_[3]<==\n";print "LINE=".__LINE__."\n";
}
}
}
if (defined $_[4] && $_[4]) {
if (ref $_[4] eq 'HASH') {
$mail=$_[4];print "LINE=".__LINE__."\n";
} elsif (ref $_[4] eq 'ARRAY') {
$track=$_[4];print "LINE=".__LINE__."\n";
} else {
if ($_[4] eq '__cleanup__') {
$cleanup=1;print "LINE=".__LINE__."\n";
} elsif ($_[4] eq '__return__') {
$return=$_[4];print "LINE=".__LINE__."\n";
} elsif ($_[4] eq '__warn__') {
$warn=1;print "LINE=".__LINE__."\n";
} elsif ($_[4]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;print "LINE=".__LINE__."\n";
} else {
print "ARG4 is NOT recognized\n==>$_[4]<==\n";print "LINE=".__LINE__."\n";
}
}
}
if (defined $_[5] && $_[5]) {
if (ref $_[5] eq 'HASH') {
$mail=$_[5];print "LINE=".__LINE__."\n";
} elsif (ref $_[5] eq 'ARRAY') {
$track=$_[5];print "LINE=".__LINE__."\n";
} else {
if ($_[5] eq '__cleanup__') {
$cleanup=1;print "LINE=".__LINE__."\n";
} elsif ($_[5] eq '__return__') {
$return=$_[5];print "LINE=".__LINE__."\n";
} elsif ($_[5] eq '__warn__') {
$warn=1;print "LINE=".__LINE__."\n";
} elsif ($_[5]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;print "LINE=".__LINE__."\n";
} else {
print "ARG5 is NOT recognized\n==>$_[5]<==\n";print "LINE=".__LINE__."\n";
}
}
}
if (defined $_[6] && $_[6]) {
if (ref $_[6] eq 'HASH') {
$mail=$_[6];print "LINE=".__LINE__."\n";
} elsif (ref $_[6] eq 'ARRAY') {
$track=$_[6];print "LINE=".__LINE__."\n";
} else {
if ($_[6] eq '__cleanup__') {
$cleanup=1;print "LINE=".__LINE__."\n";
} elsif ($_[6] eq '__return__') {
$return=$_[6];print "LINE=".__LINE__."\n";
} elsif ($_[6] eq '__warn__') {
$warn=1;print "LINE=".__LINE__."\n";
} elsif ($_[6]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;print "LINE=".__LINE__."\n";
} else {
print "ARG6 is NOT recognized\n==>$_[6]<==\n";print "LINE=".__LINE__."\n";
}
}
} my $line='';print "LINE=".__LINE__."\n";
if ($line_adjust) {
if (unpack('a1',$line_adjust) eq '-') {
$line_adjust=unpack('x1 a*',$line_adjust);print "LINE=".__LINE__."\n";
$line=$topcaller[2]-$line_adjust;print "LINE=".__LINE__."\n";
} else {
$line=$topcaller[2]+$line_adjust;print "LINE=".__LINE__."\n";
}
} else { $line=$topcaller[2] }
my $tie_err='';my $trackdb='';my $hostlabel='';print "LINE=".__LINE__."\n";
my $command='';my $suberr='';print "LINE=".__LINE__."\n";
if ($track) {
($trackdb=${$track}[0])=~s/\.db$//;print "LINE=".__LINE__."\n";
$hostlabel=${$track}[1];print "LINE=".__LINE__."\n";
$command=${$track}[2];print "LINE=".__LINE__."\n";
$suberr=${$track}[3] if defined ${$track}[3] && ${$track}[3];print "LINE=".__LINE__."\n";
$suberr||='';print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}."Track") {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Track';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Track/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $tref='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($invoked[2],$tref);print "LINE=".__LINE__."\n";
$tref=eval $tref;print "LINE=".__LINE__."\n";
if (!$status && exists ${$tref}{"${hostlabel}_$command"}
&& ${$tref}{"${hostlabel}_$command"}
eq $error) {
# loop the contents of the file
my ($k,$v) = ("","") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};print "LINE=".__LINE__."\n";
}
}
} else {
no strict 'subs';print "LINE=".__LINE__."\n";
semctl(34, 0, SETVAL, -1);print "LINE=".__LINE__."\n";
} return 1,'';print "LINE=".__LINE__."\n";
} elsif ($suberr && exists ${$tref}{"${hostlabel}_$suberr"}
&& ${$tref}{"${hostlabel}_$suberr"}
eq $suberr) {
# loop the contents of the file
my ($k,$v) = ("","") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};print "LINE=".__LINE__."\n";
}
}
} else {
no strict 'subs';print "LINE=".__LINE__."\n";
semctl(34, 0, SETVAL, -1);print "LINE=".__LINE__."\n";
} return 1,'';print "LINE=".__LINE__."\n";
} else {
${$tref}{"${hostlabel}_$command"}=$error;print "LINE=".__LINE__."\n";
my $put_tref=Data::Dump::Streamer::Dump($tref)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($invoked[2],$put_tref);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
$return='__return__';print "LINE=".__LINE__."\n";
}
# loop the contents of the file
my ($k,$v) = ("","") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
} my $errtxt='';print "LINE=".__LINE__."\n";
if (10<length $error && unpack('a11',$error) ne 'FATAL ERROR') {
$error=~s/\s*$//s;$error=~s/^\s*//s;print "LINE=".__LINE__."\n";
$errtxt="$error\n\n at $topcaller[0] "
."$topcaller[1] line $line.\n";print "LINE=".__LINE__."\n";
} else {
$errtxt=$error
}
#print $Net::FullAuto::FA_Core::MRLOG "HANDLE_ERROR ERRTXT=$errtxt<==\n";print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
print "\nAttn: --> $errtxt\n\n";print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
print "\n $errtxt"
}
if ($mail) {
if ($warn) {
send_email($mail,$Net::FullAuto::FA_Core::debug,'__warn__');print "LINE=".__LINE__."\n";
} 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");print "LINE=".__LINE__."\n";
if ($warn) {
send_email(\%mail,$Net::FullAuto::FA_Core::debug,'__warn__');print "LINE=".__LINE__."\n";
} 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);print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};print "LINE=".__LINE__."\n";
}
}
} else {
no strict 'subs';print "LINE=".__LINE__."\n";
semctl(34, 0, SETVAL, -1);print "LINE=".__LINE__."\n";
} return 0,$errtxt;print "LINE=".__LINE__."\n";
} 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);print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};print "LINE=".__LINE__."\n";
}
}
} else {
no strict 'subs';print "LINE=".__LINE__."\n";
semctl(34, 0, SETVAL, -1);print "LINE=".__LINE__."\n";
} return 0,'';print "LINE=".__LINE__."\n";
}
} elsif ($cleanup) {
&cleanup($return,'ERROR');print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"WE ARE GOING TO DIE IN HANDLE_ERROR and CALLER=",
(join ' ',@topcaller)," and ERROR=$errtxt<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($return && $warn) {
print "\n $errtxt\n";print "LINE=".__LINE__."\n";
} else { die $errtxt }
}
}
sub lookup_hostinfo_from_label
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "lookup_hostinfo_from_label() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $ip='';my $hostname='';my $use='';my $ms_share='';print "LINE=".__LINE__."\n";
my $ms_domain='';my $cmd_cnct=[''];my $ftr_cnct=[''];print "LINE=".__LINE__."\n";
my $login_id='';my $su_id='';my $chmod='';my $ping='';print "LINE=".__LINE__."\n";
my $owner='';my $group='';my $transfer_dir='';print "LINE=".__LINE__."\n";
my $rcm_chain='';my $rcm_map='';my $uname='';print "LINE=".__LINE__."\n";
my $ip_flag='';my $hn_flag='';print "LINE=".__LINE__."\n";
my $hostlabel=$_[0];my $_connect=$_[1]||'';print "LINE=".__LINE__."\n";
$hostlabel="__Master_${$}__" if lc($hostlabel) eq 'localhost';print "LINE=".__LINE__."\n";
my $timeout=0;print "LINE=".__LINE__."\n";
$use=$Hosts{$hostlabel}{'Use'} if exists
$Hosts{$hostlabel}{'Use'} &&
$Hosts{$hostlabel}{'Use'};print "LINE=".__LINE__."\n";
my $defined_use=0;print "LINE=".__LINE__."\n";
$defined_use=$use if $use;print "LINE=".__LINE__."\n";
$ping=$Hosts{$hostlabel}{'Ping'} if exists
$Hosts{$hostlabel}{'Ping'} &&
$Hosts{$hostlabel}{'Ping'};print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (!$use || (!$defined_use && $ip && !$hostname)) {
if ($key eq 'IP') {
if (ref $Hosts{$hostlabel}{$key} eq 'CODE') {
$ip=$Hosts{$hostlabel}{$key}->();print "LINE=".__LINE__."\n";
} else {
$ip=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
}
if (exists $same_host_as_Master{$ip} || $ping) {
if (exists $same_host_as_Master{$ip}
|| !(&ping($ip,'__return__'))[1]) {
$use='ip';print "LINE=".__LINE__."\n";
} else { $ip_flag=1 }
}
} elsif (lc($key) eq 'hostname') {
$hostname=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
if ($hostname && $ping) {
if (&ping($hostname,'__return__')) {
$use='hostname';print "LINE=".__LINE__."\n";
} else {
my $pinghost=$hostname;print "LINE=".__LINE__."\n";
$pinghost=substr($hostname,0,
(index $hostname,'.'))
if -1<index $hostname,'.';print "LINE=".__LINE__."\n";
if (&ping($pinghost,'__return__')) {
$Hosts{$hostlabel}{'HostName'}=$pinghost;print "LINE=".__LINE__."\n";
$hostname=$pinghost;print "LINE=".__LINE__."\n";
$use='hostname';print "LINE=".__LINE__."\n";
} else { $hn_flag=1 }
}
}
}
} elsif (lc($key) eq 'ip') {
$ip=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
}
}
}
} elsif (lc($key) eq 'hostname') {
$hostname=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
if ($ping) {
my $pinghost=$hostname;print "LINE=".__LINE__."\n";
$pinghost=substr($hostname,0,
(index $hostname,'.'))
if -1<index $hostname,'.';print "LINE=".__LINE__."\n";
unless (&ping($pinghost,'__return__')) {
if ($defined_use eq 'hostname') {
$hn_flag=1;$defined_use=0;$use=0;print "LINE=".__LINE__."\n";
}
}
}
}
if (lc($key) eq 'ms_share') {
$ms_share=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'MS_Domain') {
$ms_domain=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'Remote') {
my $rem_cnct=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
&handle_error($die);
} elsif ($_connect eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'ssh' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'telnet' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'ssh','telnet' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'telnet','ssh' ];print "LINE=".__LINE__."\n";
}
}
} else {
if ($rem_cnct eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'ssh' ];print "LINE=".__LINE__."\n";
} elsif ($rem_cnct eq 'connect_ssh') {
$cmd_cnct=[ 'ssh' ];print "LINE=".__LINE__."\n";
} elsif ($rem_cnct eq 'connect_sftp') {
$ftr_cnct=[ 'sftp' ];
} elsif ($rem_cnct eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'ssh','telnet' ];print "LINE=".__LINE__."\n";
} elsif ($rem_cnct eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'telnet' ];print "LINE=".__LINE__."\n";
} elsif ($rem_cnct eq 'connect_telnet') {
$cmd_cnct=[ 'telnet' ];print "LINE=".__LINE__."\n";
} elsif ($rem_cnct eq 'connect_ftp') {
$ftr_cnct=[ 'ftp' ];print "LINE=".__LINE__."\n";
} elsif ($ftr_cnct eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'telnet','ssh' ];print "LINE=".__LINE__."\n";
}
}
} elsif ((lc(unpack('a1',$key)) eq 'l') && (lc($key) eq 'loginid'
|| $key eq 'login')) {
$login_id=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
$Hosts{$hostlabel}{'LoginID'}=$login_id;print "LINE=".__LINE__."\n";
} 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};print "LINE=".__LINE__."\n";
$Hosts{$hostlabel}{'SU_ID'}=$su_id;print "LINE=".__LINE__."\n";
} elsif ($key eq 'Chmod') {
$chmod=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'Owner') {
$owner=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'Group') {
$group=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'Timeout') {
$timeout=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'TransferDir') {
$transfer_dir=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
$transfer_dir=~s/[\/\\]*$//;print "LINE=".__LINE__."\n";
} elsif ($key eq 'RCM_Chain') {
$rcm_chain=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'RCM_Map') {
$rcm_map=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
} elsif ($key eq 'Uname') {
$uname=$Hosts{$hostlabel}{$key};print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
}
if (!$#{$ftr_cnct}) {
if ($_connect eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'ssh' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'ssh','telnet' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_ssh') {
$cmd_cnct=[ 'ssh' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_sftp') {
$ftr_cnct=[ 'sftp' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_telnet') {
$cmd_cnct=[ 'telnet' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_ftp') {
$ftr_cnct=[ 'ftp' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'telnet' ];print "LINE=".__LINE__."\n";
} elsif ($_connect eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];print "LINE=".__LINE__."\n";
$cmd_cnct=[ 'telnet','ssh' ];print "LINE=".__LINE__."\n";
}
}
print $Net::FullAuto::FA_Core::MRLOG "WHAT IS USE?=$use\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$use || (!$ip && !$hostname)) {
my $die="Cannot Contact Server \'$hostlabel\' -";print "LINE=".__LINE__."\n";
my $fah=$Net::FullAuto::FA_Core::fa_host;print "LINE=".__LINE__."\n";
if ($ip_flag) {
$die.="\n ping (1) failed for ip address $ip";print "LINE=".__LINE__."\n";
if ($hn_flag) {
$die.="\n and hostname: $hostname\n" if $hostname;print "LINE=".__LINE__."\n";
} &handle_error($die);print "LINE=".__LINE__."\n";
} elsif ($hn_flag) {
$die.="\n ping (2) failed for hostname: $hostname &"
."\n No ip address if defined for Server"
."\n --> $hostlabel in $fah file.";print "LINE=".__LINE__."\n";
&handle_error($die);print "LINE=".__LINE__."\n";
} elsif ($hostname || ($use eq 'ip' && !$ip)) {
$use='hostname';print "LINE=".__LINE__."\n";
} elsif ($ip) {
$use='ip';print "LINE=".__LINE__."\n";
} else {
$die.="\n No ip address or hostname defined for Server"
."\n --> $hostlabel in $fah file.";print "LINE=".__LINE__."\n";
&handle_error($die);print "LINE=".__LINE__."\n";
}
} elsif ($use eq 'hostname' && !$hostname && $ip) {
$use='ip';print "LINE=".__LINE__."\n";
} elsif ($use eq 'ip' && !$ip && $hostname) {
$use='hostname';print "LINE=".__LINE__."\n";
}
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);print "LINE=".__LINE__."\n";
}
sub pty_do_cmd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $cmd='';my @args=();print "LINE=".__LINE__."\n";
($cmd,@args)=@_;print "LINE=".__LINE__."\n";
my $pty='';my $pty_err='';my $try=0;print "LINE=".__LINE__."\n";
my $capture = IO::Capture::Stderr->new();print "LINE=".__LINE__."\n";
$capture->start();print "LINE=".__LINE__."\n";
while (1) {
my $m="Hint: Try Rebooting the Local Host";print "LINE=".__LINE__."\n";
eval {
$pty = IO::Pty->new;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
if ($@=~/Cannot open/is && $try++!=4) {
sleep $try;next;print "LINE=".__LINE__."\n";
} else {
my @all_lines = $capture->read || ();print "LINE=".__LINE__."\n";
$capture->stop();print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$@."\n $all_lines[$#all_lines]\n $m");print "LINE=".__LINE__."\n";
}
} else { last }
}
$capture->stop();print "LINE=".__LINE__."\n";
$try=0;my $child='';print "LINE=".__LINE__."\n";
my $cmd_err=join ' ',@{$cmd};print "LINE=".__LINE__."\n";
my $one=shift @{$cmd};print "LINE=".__LINE__."\n";
my $doslave=${$cmd}[$#{$cmd}] eq '_slave_' ? pop @{$cmd} : '';print "LINE=".__LINE__."\n";
my $two='';my $three='';print "LINE=".__LINE__."\n";
my $four='';my $five='';print "LINE=".__LINE__."\n";
if (-1<$#{$cmd}) {
$two=shift @{$cmd};print "LINE=".__LINE__."\n";
if (-1<$#{$cmd}) {
$three=shift @{$cmd};print "LINE=".__LINE__."\n";
if (-1<$#{$cmd}) {
$four=shift @{$cmd};print "LINE=".__LINE__."\n";
}
}
}
while (1) {
my $m="Hint: Try Rebooting the Local Host";print "LINE=".__LINE__."\n";
eval {
$child = fork;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
if ($@=~/temporarily unavailable/ && $try++!=4) {
sleep 5;next;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($@."\n $m");print "LINE=".__LINE__."\n";
}
} 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
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
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";print "LINE=".__LINE__."\n";
my ($ip,$hostlabel,$hostname,$info,$apache_handle,$ua)=@_;print "LINE=".__LINE__."\n";
my @info=@{$info};print "LINE=".__LINE__."\n";
my %apache_handle=%{$apache_handle};print "LINE=".__LINE__."\n";
my %ua=%{$ua};print "LINE=".__LINE__."\n";
my $node=substr(${$DeploySMB_Proxy[0]}{'HostName'},0,
(index ${$DeploySMB_Proxy[0]}{'HostName'},'.'));print "LINE=".__LINE__."\n";
my $an="${$DeploySMB_Proxy[0]}{'IP'}:80";print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
eval {
#$apache_handle{$info[2]} = new LWP::UserAgent;print "LINE=".__LINE__."\n";
#print "GP1\n";print "LINE=".__LINE__."\n";
$apache_handle{$info[2]}->credentials(
$an,'WebRSH',$username,&getpasswd($hostlabel,$username));print "LINE=".__LINE__."\n";
$apache_handle{$info[2]}->agent(
"$progname " . $ua->agent);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
return $@;print "LINE=".__LINE__."\n";
}
}
sub test_file
{
my ($cmd_handle,$tfile)=@_;my $test_result=0;print "LINE=".__LINE__."\n";
my $shell_cmd="if\n[[ -f $tfile ]]\nthen\nif\n[[ -w $tfile ]]"
."\nthen\necho WRITE\nelse\necho READ\nfi\n"
."else\necho NOFILE\nfi";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=$cmd_handle->cmd($shell_cmd);print "LINE=".__LINE__."\n";
return $stdout;print "LINE=".__LINE__."\n";
}
sub test_dir
{
my ($cmd_handle,$tdir)=@_;my $test_result=0;print "LINE=".__LINE__."\n";
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::gbp->('printf')."printf \\\\055";print "LINE=".__LINE__."\n";
my $cnt=5;print "LINE=".__LINE__."\n";
while ($cnt--) {
$cmd_handle->print($shell_cmd);print "LINE=".__LINE__."\n";
my $leave=0;my $l='';print "LINE=".__LINE__."\n";
TD: while (1) {
while (my $line=$cmd_handle->get) {
$l.=$line;print "LINE=".__LINE__."\n";
if ($l=~/printf/s) {
if ($line=~/^WRITE|^(?:[>]\s)*WRITE/m) {
$test_result='WRITE';print "LINE=".__LINE__."\n";
$leave=1;print "LINE=".__LINE__."\n";
$l='';print "LINE=".__LINE__."\n";
} elsif ($line=~/^READ|^(?:[>]\s)*READ/m) {
$test_result='READ';print "LINE=".__LINE__."\n";
$leave=1;print "LINE=".__LINE__."\n";
$l='';print "LINE=".__LINE__."\n";
} elsif ($line=~/^NODIR|^(?:[>]\s)*NODIR/m) {
$test_result=0;print "LINE=".__LINE__."\n";
$leave=1;print "LINE=".__LINE__."\n";
$l='';print "LINE=".__LINE__."\n";
}
select(undef,undef,undef,0.02);print "LINE=".__LINE__."\n";
# sleep for 1/50th second;print "LINE=".__LINE__."\n";
$cmd_handle->print();print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
if ($l=~/_funkyPrompt_$/s) {
last TD;print "LINE=".__LINE__."\n";
} else {
select(undef,undef,undef,0.02);print "LINE=".__LINE__."\n";
# sleep for 1/50th second;print "LINE=".__LINE__."\n";
$cmd_handle->print;print "LINE=".__LINE__."\n";
}
} last if $leave;print "LINE=".__LINE__."\n";
select(undef,undef,undef,0.02);print "LINE=".__LINE__."\n";
# sleep for 1/50th second;print "LINE=".__LINE__."\n";
$cmd_handle->print;print "LINE=".__LINE__."\n";
} last if $leave;print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
} return $test_result;print "LINE=".__LINE__."\n";
}
sub inc_oct
{
my $num=$_[0];print "LINE=".__LINE__."\n";
while (1) {
$num++;print "LINE=".__LINE__."\n";
return $num if (-1==index $num,'8') && (-1==index $num,'9')
}
}
sub get_prompt {
unless ($#ascii_que) {
@ascii_que=@ascii;print "LINE=".__LINE__."\n";
} return shift @ascii_que;print "LINE=".__LINE__."\n";
}
sub clean_filehandle
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::clean_filehandle() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $filehandle=$_[0];print "LINE=".__LINE__."\n";
my $cftimeout=$_[1]||0;print "LINE=".__LINE__."\n";
if (!defined $filehandle || -1==index $filehandle,'GLOB'
|| !defined fileno $filehandle) {
if (defined $filehandle && (-1==index $filehandle,'GLOB')) {
eval {
$filehandle=$filehandle->{_cmd_handle};print "LINE=".__LINE__."\n";
$filehandle=$filehandle->{_cmd_handle}->{_cmd_handle}
if -1==index $filehandle,'GLOB';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if (($@ && -1==index $filehandle,'GLOB') ||
!defined fileno $filehandle) {
if (wantarray) {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
return '','Invalid filehandle';print "LINE=".__LINE__."\n";
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
&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__');print "LINE=".__LINE__."\n";
}
}
} else {
if (wantarray) {
if ($cftimeout) {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
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.";print "LINE=".__LINE__."\n";
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
return '','Invalid filehandle';print "LINE=".__LINE__."\n";
}
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
&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__');print "LINE=".__LINE__."\n";
}
}
} my $loop=0;my $sec=0;my $ten=0;my $hun=5;my $closederror='';print "LINE=".__LINE__."\n";
while (1) {
$Net::FullAuto::FA_Core::uhray=&Net::FullAuto::FA_Core::get_prompt();print "LINE=".__LINE__."\n";
$filehandle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');print "LINE=".__LINE__."\n";
if ($loop==100) {
my $die="100 attempts without indication that filehandle is clean";print "LINE=".__LINE__."\n";
if (wantarray) {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
return '',$die;print "LINE=".__LINE__."\n";
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
my $wait=$sec.'.'.$ten.$hun;print "LINE=".__LINE__."\n";
if ($wait!=3.00) {
if ($hun==9) {
if ($ten==9) {
$sec++;$ten=0;$hun=0;print "LINE=".__LINE__."\n";
} else {
$ten++;$hun=0;print "LINE=".__LINE__."\n";
}
} else { $hun++ }
}
select(undef,undef,undef,$wait)
if $loop++!=1; # sleep;print "LINE=".__LINE__."\n";
eval {
my $all_lines='';my $loop2=0;print "LINE=".__LINE__."\n";
while (my $line=$filehandle->get(Timeout=>30)) {
#print "CLEAN_LINE=$line and ${$Net::FullAuto::FA_Core::uhray}[0]_-<==\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$all_lines.=$line;print "LINE=".__LINE__."\n";
if (-1<index $all_lines,"$Net::FullAuto::FA_Core::uhray->[0]_-") {
if ($all_lines=~/_funkyPrompt_$/s) {
return '','';print "LINE=".__LINE__."\n";
} else {
last;print "LINE=".__LINE__."\n";
}
} elsif (-1<index $all_lines,'Exit status 0') {
$closederror='Exit status 0';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif (
$all_lines=~/(Conn.*reset|Conn.*closed|filehandle.*isn)/s) {
$closederror=$1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif ($loop2==100) {
my $die="100 attempts without indication ".
"that filehandle is clean";print "LINE=".__LINE__."\n";
if (wantarray) {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
return '',$die;print "LINE=".__LINE__."\n";
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__')
}
}
$wait=$sec.'.'.$ten.$hun;print "LINE=".__LINE__."\n";
if ($wait!=3.00) {
if ($hun==9) {
if ($ten==9) {
$sec++;$ten=0;$hun=0;print "LINE=".__LINE__."\n";
} else {
$ten++;$hun=0;print "LINE=".__LINE__."\n";
}
} else { $hun++ }
}
select(undef,undef,undef,$wait)
if $loop2++!=1; # sleep;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
if ($@) {
if (wantarray) {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
return '',$@;print "LINE=".__LINE__."\n";
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
&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__');print "LINE=".__LINE__."\n";
}
} elsif ($closederror) {
if (wantarray) {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
return '',$closederror;print "LINE=".__LINE__."\n";
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
&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__');print "LINE=".__LINE__."\n";
}
} else {
&release_fa_lock(7755);print "LINE=".__LINE__."\n";
select(undef,undef,undef,0.02);print "LINE=".__LINE__."\n";
# sleep for 1/50th second;print "LINE=".__LINE__."\n";
return '',''
}
}
} ## END of &clean_filehandle
sub attempt_cmd_xtimes
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::attempt_cmd_xtimes() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $cmd_handle=$_[0];print "LINE=".__LINE__."\n";
my $cmd=$_[1];print "LINE=".__LINE__."\n";
my $num_of_attempts=$_[2]||100;print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
if (-1==index $cmd_handle,'GLOB' || !defined fileno $cmd_handle) {
if (-1==index $cmd_handle,'GLOB') {
eval {
$cmd_handle=$cmd_handle->{_cmd_handle};print "LINE=".__LINE__."\n";
$cmd_handle=$cmd_handle->{_cmd_handle}->{_cmd_handle}
if -1==index $cmd_handle,'GLOB';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if (($@ && -1==index $cmd_handle,'GLOB') ||
!defined fileno $cmd_handle) {
if (wantarray) {
return '','Connection closed';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($@,'__cleanup__')
}
}
} else {
if (wantarray) {
return '','Connection closed';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"$cmd_handle is NOT a valid filehandle",'__cleanup__')
}
}
}
my $hostlabel=$_[2];print "LINE=".__LINE__."\n";
my $cou=100;print "LINE=".__LINE__."\n";
while ($cou--) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
$cmd,'__live__');print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (!$stdout) {
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);print "LINE=".__LINE__."\n";
$cfh_error||='Not a GLOB reference' if $cou==1;print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
select(undef,undef,undef,0.02);print "LINE=".__LINE__."\n";
$cmd_handle->print(
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;$cmd;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');print "LINE=".__LINE__."\n";
my $allins='';my $ct=0;print "LINE=".__LINE__."\n";
while (my $line=$cmd_handle->get) {
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
$allins.=$line;print "LINE=".__LINE__."\n";
#print "PUSH_CMD_LINE_QQQQQQQQQQQ=$allins<== AND LINE=$line<==\n";print "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,'*';print "LINE=".__LINE__."\n";
if ($allins=~/!!(.*)%%/) {
$stdout=$1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} else {
$cmd_handle->
print($Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\055');print "LINE=".__LINE__."\n";
}
if ($ct++==10) {
$cmd_handle->print;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
} else { last }
}
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
return $stdout;print "LINE=".__LINE__."\n";
}
sub master_transfer_dir
{
my $localhost=$_[0];print "LINE=".__LINE__."\n";
my $tdir='';my $transfer_dir='';my $curdir='';print "LINE=".__LINE__."\n";
my $output='';my $stderr='';my $work_dirs={};my $endp=0;my $testd='';print "LINE=".__LINE__."\n";
while (1) {
if ($^O eq 'cygwin') {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $cdr='';print "LINE=".__LINE__."\n";
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;print "LINE=".__LINE__."\n";
$cdr=unpack("x$l_cd a*",$curdir);print "LINE=".__LINE__."\n";
substr($cdr,1,0)=':';print "LINE=".__LINE__."\n";
$cdr=ucfirst($cdr);print "LINE=".__LINE__."\n";
$cdr=~s/\//\\\\/g;print "LINE=".__LINE__."\n";
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;print "LINE=".__LINE__."\n";
}
$work_dirs->{_pre}=$curdir.'/' if $curdir ne '/';print "LINE=".__LINE__."\n";
$work_dirs->{_pre_mswin}=$cdr.'\\\\';print "LINE=".__LINE__."\n";
} else {
($curdir,$stderr)=$localhost->cmd('pwd');print "LINE=".__LINE__."\n";
$work_dirs->{_pre}=$curdir.'/' if $curdir ne '/';print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
last if $curdir;print "LINE=".__LINE__."\n";
}
if (exists $Hosts{"__Master_${$}__"}{'TransferDir'}) {
$master_transfer_dir=$tdir=$Hosts{"__Master_${$}__"}{'TransferDir'};print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
}
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin};print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
'TransferDir not Writable');print "LINE=".__LINE__."\n";
}
}
} elsif ($tdir=~/^[a-zA-Z]:/) {
if ($^O eq 'cygwin') {
my ($drive,$path)=unpack('a1 x1 a*',$tdir);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
${$work_dirs}{_cwd}=$localhost->{_cygdrive}
.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
$testd=&test_dir($localhost->{_cmd_handle},
${$work_dirs}{_cwd});print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
if ($tdir ne $curdir) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_cwd});print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
$work_dirs->{_cwd_mswin}=$tdir.'\\';print "LINE=".__LINE__."\n";
} else {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin};print "LINE=".__LINE__."\n";
$work_dirs->{_cwd}=$work_dirs->{_pre};print "LINE=".__LINE__."\n";
}
$work_dirs->{'_tmp_mswin'}=$work_dirs->{'_cwd_mswin'};print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{'_tmp'}=$work_dirs->{'_cwd'};print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"TransferDir not Writable and TESTD=$testd<==".
" and work_dirs-_cwd=$work_dirs->{_cwd}<==");print "LINE=".__LINE__."\n";
}
}
my $warn="Cannot cd to $tdir\n\tOperating " .
"System is $^O - NOT cygwin!";print "LINE=".__LINE__."\n";
warn "$warn $!";print "LINE=".__LINE__."\n";
} $tdir=~tr/\\/\//;print "LINE=".__LINE__."\n";
$testd=&test_dir($localhost->{_cmd_handle},$tdir);print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
my $drive='';my $path='';print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
$tdir=~s/$localhost->{_cygdrive_regex}//;print "LINE=".__LINE__."\n";
($drive,$path)=unpack('a1 a*',$tdir);print "LINE=".__LINE__."\n";
$tdir=$drive.':'.$path;print "LINE=".__LINE__."\n";
$tdir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$tdir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
}
if ($tdir ne $curdir) {
if ($^O eq 'cygwin') {
$work_dirs->{_cwd}=$localhost->{_cygdrive}
.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_cwd});print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
$work_dirs->{_cwd_mswin}=$tdir.'\\';print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=$localhost->cmd("cd $tdir");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
$work_dirs->{_cwd}=$tdir.'/';print "LINE=".__LINE__."\n";
}
} else {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin}
if $^O eq 'cygwin';print "LINE=".__LINE__."\n";
$work_dirs->{_cwd}=$work_dirs->{_pre};print "LINE=".__LINE__."\n";
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin}
if $^O eq 'cygwin';print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
}
}
if ($^O eq 'cygwin') {
($output,$stderr)=$localhost->cmd("cd /tmp");print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if (!$stderr || ($stderr=~/^.*cd \/tmp 2[>][&]1$/)) {
my $cnt=2;print "LINE=".__LINE__."\n";
while ($cnt--) {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $cdr='';print "LINE=".__LINE__."\n";
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;print "LINE=".__LINE__."\n";
$cdr=unpack("x$l_cd a*",$curdir);print "LINE=".__LINE__."\n";
substr($cdr,1,0)=':';print "LINE=".__LINE__."\n";
$cdr=ucfirst($cdr);print "LINE=".__LINE__."\n";
$cdr=~s/\//\\\\/g;print "LINE=".__LINE__."\n";
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;print "LINE=".__LINE__."\n";
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin}=$cdr.'\\\\';print "LINE=".__LINE__."\n";
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$curdir.'/';print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
} elsif ($testd eq 'READ' || $testd eq 'NOFILE') {
last;print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=$localhost->cmd('cd -')
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
}
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
}
}
if ((${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
'/tmp','Target','',"__Master_${$}__")) {
$testd=&test_dir($localhost->{_cmd_handle},
$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin};print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
}
}
if (($work_dirs->{_tmp},$work_dirs->{_tmp_mswin})
=&File_Transfer::get_drive(
'/temp','Target','',"__Master_${$}__")) {
$testd=&test_dir($localhost->{_cmd_handle},
$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin};print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
}
}
($output,$stderr)=$localhost->cmd("cd $home_dir");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
if (!$stderr) {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $cdr='';print "LINE=".__LINE__."\n";
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;print "LINE=".__LINE__."\n";
$cdr=unpack("x$l_cd a*",$curdir);print "LINE=".__LINE__."\n";
substr($cdr,1,0)=':';print "LINE=".__LINE__."\n";
$cdr=ucfirst($cdr);print "LINE=".__LINE__."\n";
$cdr=~s/\//\\\\/g;print "LINE=".__LINE__."\n";
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\//\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;print "LINE=".__LINE__."\n";
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin}=$cdr.'\\';print "LINE=".__LINE__."\n";
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$curdir;print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=$localhost->cmd('cd -')
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
}
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin};print "LINE=".__LINE__."\n";
$work_dirs->{_tmp_mswin}=$work_dirs->{_pre_mswin};print "LINE=".__LINE__."\n";
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$work_dirs->{_pre};print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
} else {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!";print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
} $testd=&test_dir($localhost->{_cmd_handle},'/tmp');print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
($output,$stderr)=$localhost->cmd('cd /tmp')
if '/tmp' ne $curdir;print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}='/tmp/';print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
} $testd=&test_dir($localhost->{_cmd_handle},$home_dir);print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
($output,$stderr)=$localhost->cmd("cd $home_dir")
if $home_dir ne $curdir;print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}=$home_dir.'/';print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if ($testd eq 'WRITE') {
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}=$curdir.'/';print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
} else {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!";print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
sub master_transfer_dir_no_telnet_login
{
#my $transfer_dir='';print "LINE=".__LINE__."\n";
my $curdir=Cwd::getcwd();print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'TransferDir'}
&& -d $Hosts{"__Master_${$}__"}{'TransferDir'}
&& -w _) {
$master_transfer_dir=$Hosts{"__Master_${$}__"}{'TransferDir'};print "LINE=".__LINE__."\n";
if (unpack('x1 a1',"$master_transfer_dir") eq ':') {
my ($drive,$path)=unpack('a1 @2 a*',$master_transfer_dir);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
$master_transfer_dir=$localhost->{_cygdrive}."/$drive$path/";print "LINE=".__LINE__."\n";
}
} elsif ($^O ne 'cygwin' &&
$^O ne 'MSWin32' &&
$^O ne 'MSWin64' &&
$ENV{OS} ne 'Windows_NT' &&
-d '/tmp' && -w _) {
$master_transfer_dir="/tmp/";print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
-d $localhost->{_cygdrive}.'/c/tmp' && -w _) {
$master_transfer_dir=$localhost->{_cygdrive}.'/c/tmp/';print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
-d $localhost->{_cygdrive}.'/c/temp' && -w _) {
$master_transfer_dir=$localhost->{_cygdrive}.'/c/temp/';print "LINE=".__LINE__."\n";
} elsif (-d $home_dir && -w _) {
$master_transfer_dir=$home_dir;print "LINE=".__LINE__."\n";
if (unpack('@1 a1',$master_transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$master_transfer_dir);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
$master_transfer_dir=$localhost->{_cygdrive}.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
}
} elsif (!(-w $curdir)) {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!\n";print "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
} else {
print "GETTING CURDIR FOR TRANSFER=",cwd(),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$master_transfer_dir=$curdir;print "LINE=".__LINE__."\n";
}
$localhost->{_cwd}{_cwd}=Cwd::getcwd();print "LINE=".__LINE__."\n";
return $master_transfer_dir;print "LINE=".__LINE__."\n";
}
sub getpasswd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::getpasswd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $passlabel=$_[0];$passlabel||='';my $use='';print "LINE=".__LINE__."\n";
my $host='';my $hostlabel='';my $sshport='';print "LINE=".__LINE__."\n";
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'}->();print "LINE=".__LINE__."\n";
$hostlabel=$passlabel;print "LINE=".__LINE__."\n";
} else {
$host=$Hosts{$passlabel}{'IP'};print "LINE=".__LINE__."\n";
$hostlabel=$passlabel;print "LINE=".__LINE__."\n";
}
$use='ip';print "LINE=".__LINE__."\n";
} else {
$host=$Hosts{$passlabel}{'HostName'};print "LINE=".__LINE__."\n";
$use='hostname';print "LINE=".__LINE__."\n";
$hostlabel=$passlabel;print "LINE=".__LINE__."\n";
}
} else {
$host=$Hosts{$passlabel}{'HostName'};print "LINE=".__LINE__."\n";
$use='hostname';print "LINE=".__LINE__."\n";
$hostlabel=$passlabel;print "LINE=".__LINE__."\n";
}
} else {
$host=$Hosts{$passlabel}{'HostName'};print "LINE=".__LINE__."\n";
$use='hostname';print "LINE=".__LINE__."\n";
$hostlabel=$passlabel;print "LINE=".__LINE__."\n";
}
} elsif (exists $Hosts{$passlabel}{'IP'}) {
if (ref $Hosts{$passlabel}{'IP'} eq 'CODE') {
$host=$Hosts{$passlabel}{'IP'}->();print "LINE=".__LINE__."\n";
} else {
$host=$Hosts{$passlabel}{'IP'};print "LINE=".__LINE__."\n";
}
$hostlabel=$passlabel;print "LINE=".__LINE__."\n";
$use='ip';print "LINE=".__LINE__."\n";
}
if (exists $Hosts{$passlabel}{'sshport'}) {
$sshport=$Hosts{$passlabel}{'sshport'};print "LINE=".__LINE__."\n";
}
}
my $login_id=$_[1];print "LINE=".__LINE__."\n";
my $force=0;my $su_login=0;print "LINE=".__LINE__."\n";
my $ms_domain='';my $errmsg='';print "LINE=".__LINE__."\n";
my $track='';my $prox='';print "LINE=".__LINE__."\n";
my $pass='';my $save_passwd='';print "LINE=".__LINE__."\n";
my $cmd_type='';my $status='';print "LINE=".__LINE__."\n";
my $encrypted_passwd='';print "LINE=".__LINE__."\n";
my $bdb='';print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
if (defined $_[2] && $_[2]) {
if ($_[2] eq '__force__') {
$force=1;print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__su__') {
$su_login=1;print "LINE=".__LINE__."\n";
} else {
$ms_domain=$_[2];print "LINE=".__LINE__."\n";
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__force__') {
$force=1;print "LINE=".__LINE__."\n";
} elsif ($_[3] eq '__su__') {
$su_login=1;print "LINE=".__LINE__."\n";
} else {
$errmsg=$_[3];print "LINE=".__LINE__."\n";
$errmsg=~s/\s+$//s;print "LINE=".__LINE__."\n";
$errmsg.="\n";print "LINE=".__LINE__."\n";
$force=1;print "LINE=".__LINE__."\n";
}
}
if (defined $_[4] && $_[4]) {
if ($_[4] eq '__force__') {
$force=1;print "LINE=".__LINE__."\n";
} elsif ($_[4] eq '__su__') {
$su_login=1;print "LINE=".__LINE__."\n";
} else {
$track=$_[4];print "LINE=".__LINE__."\n";
}
}
if (defined $_[5] && $_[5]) {
if ($_[5] eq '__force__') {
$force=1;print "LINE=".__LINE__."\n";
} elsif ($_[5] eq '__su__') {
$su_login=1;print "LINE=".__LINE__."\n";
} else {
$cmd_type=$_[5];print "LINE=".__LINE__."\n";
$prox='SMB_Proxy' if $cmd_type eq 'smb';print "LINE=".__LINE__."\n";
}
}
if (defined $_[6] && $_[6]) {
if ($_[6] eq '__force__') {
$force=1;print "LINE=".__LINE__."\n";
} elsif ($_[6] eq '__su__') {
$su_login=1;print "LINE=".__LINE__."\n";
}
}
if (defined $_[7] && $_[7]) {
if ($_[7] eq '__force__') {
$force=1;print "LINE=".__LINE__."\n";
} elsif ($_[7] eq '__su__') {
$su_login=1;print "LINE=".__LINE__."\n";
}
}
my $cipher='';print "LINE=".__LINE__."\n";
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'});print "LINE=".__LINE__."\n";
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
}
my $local_host_flag=0;my $href='';print "LINE=".__LINE__."\n";
if ((exists $same_host_as_Master{$passlabel} && !$sshport) ||
($passlabel eq "__Master_${$}__")) {
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";print "LINE=".__LINE__."\n";
$passlabel=$hostlab;print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
if (!$local_host_flag) {
$passlabel='localhost';print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
}
if ($hostlabel eq "__Master_${$}__") {
$hostlabel='localhost';print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
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 ";print "LINE=".__LINE__."\n";
&handle_error($herr.($!));print "LINE=".__LINE__."\n";
}
my $key='';print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::plan) {
#my $pl=$Net::FullAuto::FA_Core::plan->{Number};print "LINE=".__LINE__."\n";
#print "WHAT IS PL=$pl<==\n";<STDIN>;print "LINE=".__LINE__."\n";
if ($local_host_flag && $username eq $login_id) {
$key="${username}_X_${passlabel}_X_${$}_X_$invoked[0]";print "LINE=".__LINE__."\n";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${passlabel}_X_${cmd_type}";print "LINE=".__LINE__."\n";
} else {
$key="${username}_X_${login_id}_X_${passlabel}";print "LINE=".__LINE__."\n";
}
} else {
if ($local_host_flag && $username eq $login_id) {
$key="${username}_X_${passlabel}_X_${$}_X_$invoked[0]";print "LINE=".__LINE__."\n";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${passlabel}_X_${cmd_type}";print "LINE=".__LINE__."\n";
} else {
$key="${username}_X_${login_id}_X_${passlabel}";print "LINE=".__LINE__."\n";
}
}
if ($Net::FullAuto::FA_Core::scrub) {
if ($passlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";print "LINE=".__LINE__."\n";
unless ($Net::FullAuto::FA_Core::tosspass) {
&scrub_passwd_file($hostlab,$login_id);print "LINE=".__LINE__."\n";
} else {
delete $Net::FullAuto::FA_Core::tosspass{$key};print "LINE=".__LINE__."\n";
}
}
} else {
unless ($Net::FullAuto::FA_Core::tosspass) {
&scrub_passwd_file($passlabel,$login_id)
} else {
delete $Net::FullAuto::FA_Core::tosspass{$key};print "LINE=".__LINE__."\n";
}
} $force=1;print "LINE=".__LINE__."\n";
}
my $kind='prod';print "LINE=".__LINE__."\n";
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
my $tie_err="can't open tie to "
. $Hosts{"__Master_${$}__"}{'FA_Secure'}
."${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
unless ($Net::FullAuto::FA_Core::tosspass) {
print $MRLOG "PASSWDDB=",
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db","<==\n"
if -1<index $MRLOG,'*';print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
$status=$bdb->db_get($passlabel,$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
$href||={};print "LINE=".__LINE__."\n";
print $MRLOG "HREF=$href and KEY=$key and KEYS=",
(join "\n",keys %{$href}),"<==\n"
if -1<index $MRLOG,'*';print "LINE=".__LINE__."\n";
if (exists $href->{$key} && !$force) {
my $pspath=$Net::FullAuto::FA_Core::gbp->('ps');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'ps'}) {
$pspath=$Hosts{"__Master_${$}__"}{'ps'};print "LINE=".__LINE__."\n";
$pspath.='/' if $pspath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=
&Net::FullAuto::FA_Core::cmd(
"${pspath}ps -e",'__escape__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__')
if $stderr;print "LINE=".__LINE__."\n";
my $encrypted_passwd=$href->{$key};print "LINE=".__LINE__."\n";
foreach my $ky (keys %{$href}) {
if ($ky=~/_X_(\d+)_X_\d+$/) {
my $one=$1;print "LINE=".__LINE__."\n";
delete $href->{$ky} if (-1==index $stdout,$one);print "LINE=".__LINE__."\n";
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($passlabel,$put_href);print "LINE=".__LINE__."\n";
undef $bdb;
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
$pass='';print "LINE=".__LINE__."\n";
eval {
$pass=$cipher->decrypt($encrypted_passwd);print "LINE=".__LINE__."\n";
chop $pass if $pass eq substr($pass,0,(rindex $pass,'.')).'X';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
# --CONTINUE-- print "WHAT IS PASS=$pass<====\n";print "LINE=".__LINE__."\n";
return $pass if $pass && $pass!~tr/\0-\37\177-\377//;print "LINE=".__LINE__."\n";
if (!$pass && $oldpasswd) {
my $cipher = new Crypt::CBC($oldpasswd,
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$save_passwd=$cipher->decrypt($encrypted_passwd);print "LINE=".__LINE__."\n";
}
} 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);print "LINE=".__LINE__."\n";
}
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($passlabel,$put_href);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
} else {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
}
&scrub_passwd_file($passlabel,$login_id) if
$errmsg=~/Permission denied|Password:/s;print "LINE=".__LINE__."\n";
# SCRUB PROBLEM;print "LINE=".__LINE__."\n";
} elsif (!$force && (exists $Net::FullAuto::FA_Core::tosspass{$key})) {
$save_passwd=$Net::FullAuto::FA_Core::tosspass{$key};print "LINE=".__LINE__."\n";
}
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";print "LINE=".__LINE__."\n";
&handle_error($die,'',$track);print "LINE=".__LINE__."\n";
return '',$die;print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
&handle_error($die,'',$track);print "LINE=".__LINE__."\n";
return '',$die;print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
&handle_error($die,'',$track);print "LINE=".__LINE__."\n";
return '',$die;print "LINE=".__LINE__."\n";
}
}
my $loop_count=0;print "LINE=".__LINE__."\n";
while (1) {
$loop_count++;print "LINE=".__LINE__."\n";
print $blanklines;print "LINE=".__LINE__."\n";
my $errm=$errmsg;print "LINE=".__LINE__."\n";
$errm=~s/^(.*) (at .*)$/$1\n $2/s;print "LINE=".__LINE__."\n";
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n ERROR MESSAGE (1) -> $errm";print "LINE=".__LINE__."\n";
} else {
print "\n ERROR MESSAGE -> $errm";print "LINE=".__LINE__."\n";
}
}
my $print1='';print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\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";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter the MS Domain password for "
.$login_id
."\n (Needed for HostLabel \'$passlabel\' - $host)\n";print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (3) authentication password."
."\n (Needed for Label \'$passlabel\')\n";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for Label \'$passlabel\')\n";print "LINE=".__LINE__."\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 "
."HostLabel \'$hostlabel\')\n";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter the \'root\' password for $host."
."\n (Needed for "
."HostLabel \'$hostlabel\')\n";print "LINE=".__LINE__."\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";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter the \'root\' password for $host."
."\n (Needed for HostLabel \'$passlabel\')\n";print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (6) authentication password."
."\n (Needed for Label \'$passlabel\')\n";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for Label \'$passlabel\')\n";print "LINE=".__LINE__."\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";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter $login_id\'s password for $host."
."\n (WNeeded for ${prox}Local Host \'$host\')\n";print "LINE=".__LINE__."\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 \'$hostlabel\')\n";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter $login_id\'s password for $host."
."\n (Needed for ${prox}HostLabel \'$hostlabel\')\n";print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (9) authentication password."
."\n (Needed for ${prox}Label \'$passlabel\')\n";print "LINE=".__LINE__."\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for ${prox}Label \'$passlabel\')\n";print "LINE=".__LINE__."\n";
}
}
}
my $passwd_timeout=350;print "LINE=".__LINE__."\n";
my $te_time=time;print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9854);print "LINE=".__LINE__."\n";
print $print1;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
print "\n Password (1): ";print "LINE=".__LINE__."\n";
} else {
print "\n Password: ";print "LINE=".__LINE__."\n";
}
ReadMode 2;print "LINE=".__LINE__."\n";
$save_passwd=<STDIN>;print "LINE=".__LINE__."\n";
&release_fa_lock(9854);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@ eq "alarm\n") {
print "\n\n";print "LINE=".__LINE__."\n";
$errmsg.="\n\n ".
"Time Allowed for Password Input has Expired.\n";print "LINE=".__LINE__."\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error') {
my $body='';print "LINE=".__LINE__."\n";
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
$body="\n ERROR MESSAGE (2) -> $errmsg";print "LINE=".__LINE__."\n";
} else {
$body="\n ERROR MESSAGE -> $errmsg";print "LINE=".__LINE__."\n";
}
}
$body.=$print1;my $subject='';print "LINE=".__LINE__."\n";
if ($host) {
$subject="Login Failed for $login_id on $host";print "LINE=".__LINE__."\n";
} else {
$subject="Authentication Failed";print "LINE=".__LINE__."\n";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::send_email(\%mail);print "LINE=".__LINE__."\n";
}
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');print "LINE=".__LINE__."\n";
}
my $te_time2=time;
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$save_passwd)) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
}
ReadMode 0;print "LINE=".__LINE__."\n";
chomp($save_passwd);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error') {
my $body='';print "LINE=".__LINE__."\n";
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
$body="\n ERROR MESSAGE (3) -> $errmsg";print "LINE=".__LINE__."\n";
} else {
$body="\n ERROR MESSAGE -> $errmsg";print "LINE=".__LINE__."\n";
}
}
$body.=$print1;my $subject='';print "LINE=".__LINE__."\n";
if ($host) {
$subject="Login Failed for $login_id on $host";print "LINE=".__LINE__."\n";
} else {
$subject="Authentication Failed";print "LINE=".__LINE__."\n";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::send_email(\%mail);print "LINE=".__LINE__."\n";
}
last if $save_passwd;print "LINE=".__LINE__."\n";
}
}
unless ($Net::FullAuto::FA_Core::tosspass) {
my $mkdflag=0;print "LINE=".__LINE__."\n";
my $mr="__Master_".$$."__";print "LINE=".__LINE__."\n";
unless (-d $Hosts{$mr}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{$mr}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{$mr}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{$mr}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{$mr}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB:".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{$mr}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
$status=$bdb->db_get($passlabel,$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
while (delete $href->{$key}) {}
$save_passwd.='X' if $save_passwd
eq substr($Net::FullAuto::FA_Core::progname,0,
(rindex $Net::FullAuto::FA_Core::progname,'.'));print "LINE=".__LINE__."\n";
my $cipher='';print "LINE=".__LINE__."\n";
if ($Hosts{$mr}{'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'});print "LINE=".__LINE__."\n";
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
my $new_encrypted=$cipher->encrypt($save_passwd);print "LINE=".__LINE__."\n";
$href->{$key}=$new_encrypted;print "LINE=".__LINE__."\n";
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($passlabel,$put_href);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::tosspass{$key}=$save_passwd;print "LINE=".__LINE__."\n";
}
return $save_passwd;print "LINE=".__LINE__."\n";
}
sub chgdir
{
my $pwd='';my $destdir=$_[1];print "LINE=".__LINE__."\n";
my $cmd_handle=$_[0];print "LINE=".__LINE__."\n";
$cmd_handle->cmd("cd $destdir");print "LINE=".__LINE__."\n";
($pwd)=$cmd_handle->cmd('pwd');print "LINE=".__LINE__."\n";
$pwd=~s/^(.*)?{\n}.*$/$1/;print "LINE=".__LINE__."\n";
chomp($pwd);print "LINE=".__LINE__."\n";
#print "PWD=$pwd and DEST=$_[1]\n";<STDIN>;print "LINE=".__LINE__."\n";
if ($pwd eq $_[1] or "$pwd/" eq "$_[1]") { return 1 }
else {
print "FATAL ERROR! The directory \"$_[1]\" does NOT exist!";print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
}
}
sub runcmd # USAGE: &runcmd(FileHandle, "command_to_run_string")
{
my @output=${$_[0]}->cmd($_[1]);print "LINE=".__LINE__."\n";
foreach (@output) {
if (/Execute permiss/) {
print "FATAL ERROR! Execute permission denied for command:";print "LINE=".__LINE__."\n";
print "--> $_[1]\n";print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
}
} return \@output;print "LINE=".__LINE__."\n";
}
sub check_if_websphere_is_running
{
my ($cmd_handle,$applic)=@_;print "LINE=".__LINE__."\n";
return if $websphere_not_running==1;print "LINE=".__LINE__."\n";
my @ls=$cmd_handle->cmd("ls -C1 /usr/WebSphere/AppServer/bin");print "LINE=".__LINE__."\n";
my $wscp_UX||='';print "LINE=".__LINE__."\n";
@ls=grep { /^wscp/ } @ls;print "LINE=".__LINE__."\n";
print "--> Verifying that WebSphere is Offline ...\n";print "LINE=".__LINE__."\n";
my $wscp_sub = sub {
my $wscp_copy=$wscp_UX;print "LINE=".__LINE__."\n";
substr($wscp_copy,(index $wscp_UX,'__JVM__'),7)=$_[1];print "LINE=".__LINE__."\n";
#&chgdir($cmd_handle,"/usr/WebSphere/AppServer/bin")
# || handle_error(
# "Cannot &chgdir /usr/WebSphere/AppServer/bin");print "LINE=".__LINE__."\n";
my ($output,$stderr)=$cmd_handle->cwd(
"/usr/WebSphere/AppServer/bin");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $app='';print "LINE=".__LINE__."\n";
$output=&runcmd($_[0],$wscp_copy) ||
&handle_error("Cannot &runcmd $wscp_copy");print "LINE=".__LINE__."\n";
my @output=@{$output};print "LINE=".__LINE__."\n";
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/}.*$//;print "LINE=".__LINE__."\n";
my $die="\n FATAL ERROR! - \"$serv\" is RUNNING!\n\n";print "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
foreach (@ls) {
chomp;print "LINE=".__LINE__."\n";
my $num='';print "LINE=".__LINE__."\n";
($num=$_)=~s/^wscp(\d+)\.sh$/$1/;print "LINE=".__LINE__."\n";
$num='' if substr($num,0,4)=='wscp';print "LINE=".__LINE__."\n";
$wscp_sub->($cmd_handle,$num);print "LINE=".__LINE__."\n";
} $websphere_not_running=1;print "LINE=".__LINE__."\n";
}
sub apache_download
{
$| = 1; # autoflush
my $ua = new LWP::UserAgent;print "LINE=".__LINE__."\n";
my ($file,$host,$hostlabel)=@_;print "LINE=".__LINE__."\n";
my ($size,$start_t,$length,$flength,$last_dur)='';print "LINE=".__LINE__."\n";
$ua->agent("$progname " . $ua->agent);print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
#print "GP3\n";print "LINE=".__LINE__."\n";
$ua->credentials("$Hosts{\"__Master_${$}__\"}{'IP'}:80",'WebRSH',
"$username",&getpasswd($hostlabel,$username));print "LINE=".__LINE__."\n";
$ua->env_proxy;print "LINE=".__LINE__."\n";
my $url="http://${$ApacheNode[0]}[0]/download/$_[0]";print "LINE=".__LINE__."\n";
my $req = new HTTP::Request GET => $url;print "LINE=".__LINE__."\n";
my $shown = 0; # have we called the show() function yet
my $res = $ua->request($req,
sub {
my $res = $_[1];print "LINE=".__LINE__."\n";
open(FILE, ">$file") ||
&handle_error("Can't open $file: ");print "LINE=".__LINE__."\n";
binmode FILE;print "LINE=".__LINE__."\n";
$length = $res->content_length;print "LINE=".__LINE__."\n";
$flength = fbytes($length) if defined $length;print "LINE=".__LINE__."\n";
$start_t = time;print "LINE=".__LINE__."\n";
$last_dur = 0;print "LINE=".__LINE__."\n";
$size += length($_[0]);print "LINE=".__LINE__."\n";
print FILE $_[0];print "LINE=".__LINE__."\n";
if (defined $length) {
my $dur = time - $start_t;print "LINE=".__LINE__."\n";
if ($dur != $last_dur) { # don't update too often
$last_dur = $dur;print "LINE=".__LINE__."\n";
my $perc = $size / $length;print "LINE=".__LINE__."\n";
my $speed = fbytes($size/$dur) . "/sec" if $dur > 3;print "LINE=".__LINE__."\n";
my $secs_left = fduration($dur/$perc - $dur);print "LINE=".__LINE__."\n";
$perc = int($perc*100);print "LINE=".__LINE__."\n";
my $show = "$perc% of $flength";print "LINE=".__LINE__."\n";
$show .= " (at $speed, $secs_left remaining)" if $speed;print "LINE=".__LINE__."\n";
show($show, 1);print "LINE=".__LINE__."\n";
}
} else {
show( fbytes($size) . " received");print "LINE=".__LINE__."\n";
}
}
);print "LINE=".__LINE__."\n";
if ($res->is_success || $res->message =~ /^Interrupted/) {
show("");print "LINE=".__LINE__."\n";
print "\r";print "LINE=".__LINE__."\n";
print fbytes($size);print "LINE=".__LINE__."\n";
print " of ", fbytes($length) if defined($length) && $length != $size;print "LINE=".__LINE__."\n";
print " received";print "LINE=".__LINE__."\n";
my $dur = time - $start_t;print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
if ($dur) {
my $speed = fbytes($size/$dur) . "/sec";print "LINE=".__LINE__."\n";
print " in ", fduration($dur), " ($speed)";print "LINE=".__LINE__."\n";
}
print "\n";print "LINE=".__LINE__."\n";
}
my $died = $res->header("X-Died");print "LINE=".__LINE__."\n";
if ($died || !$res->is_success) {
if (-t) {
print "Transfer aborted. Delete $file? [n] ";print "LINE=".__LINE__."\n";
my $ans = <STDIN>;print "LINE=".__LINE__."\n";
unlink($file) if defined($ans) && $ans =~ /^y\n/;print "LINE=".__LINE__."\n";
} else {
print "Transfer aborted, $file kept\n";print "LINE=".__LINE__."\n";
}
}
} else {
print "\n" if $shown;print "LINE=".__LINE__."\n";
print "${Net::FullAuto::FA_Core::progname}.pl: ", $res->status_line, "\n";print "LINE=".__LINE__."\n";
exit 1;print "LINE=".__LINE__."\n";
}
}
sub fbytes
{
my $n = int(shift);print "LINE=".__LINE__."\n";
if ($n >= 1024 * 1024) {
return sprintf "%.3g MB", $n / (1024.0 * 1024);print "LINE=".__LINE__."\n";
} elsif ($n >= 1024) {
return sprintf "%.3g KB", $n / 1024.0;print "LINE=".__LINE__."\n";
} else {
return "$n bytes";print "LINE=".__LINE__."\n";
}
}
sub fduration
{
use integer;print "LINE=".__LINE__."\n";
my $secs = int(shift);print "LINE=".__LINE__."\n";
my $hours = $secs / (60*60);print "LINE=".__LINE__."\n";
$secs -= $hours * 60*60;print "LINE=".__LINE__."\n";
my $mins = $secs / 60;print "LINE=".__LINE__."\n";
$secs %= 60;print "LINE=".__LINE__."\n";
if ($hours) {
return "$hours hours $mins minutes";print "LINE=".__LINE__."\n";
} elsif ($mins >= 2) {
return "$mins minutes";print "LINE=".__LINE__."\n";
} else {
$secs += $mins * 60;print "LINE=".__LINE__."\n";
return "$secs seconds";print "LINE=".__LINE__."\n";
}
}
BEGIN {
my @ani = qw(- \ | /);print "LINE=".__LINE__."\n";
my $ani = 0;print "LINE=".__LINE__."\n";
sub show
{
my($mess, $show_ani) = @_;print "LINE=".__LINE__."\n";
print "\r$mess" . (" " x (75 - length $mess));print "LINE=".__LINE__."\n";
print $show_ani ? "$ani[$ani++]\b" : " ";print "LINE=".__LINE__."\n";
$ani %= @ani;print "LINE=".__LINE__."\n";
$shown++;print "LINE=".__LINE__."\n";
}
}
sub Net::Telnet::select_dir
{
print "NetSELECTDIRCALLER=",caller,"\n";#<STDIN>;print "LINE=".__LINE__."\n";
return File_Transfer::select_dir(@_);print "LINE=".__LINE__."\n";
}
sub Net::Telnet::diff
{
return File_Transfer::diff(@_);print "LINE=".__LINE__."\n";
}
sub Net::Telnet::mirror
{
return File_Transfer::mirror(@_);print "LINE=".__LINE__."\n";
}
sub send_email
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::send_email() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $usage='notify_on_error';my $mail_module='Mail::Sender';print "LINE=".__LINE__."\n";
my $mail_method='';my $mail_server='';my $mail_port='';print "LINE=".__LINE__."\n";
my $bcc='';my $cc='';my $content_type='';my $priority='';print "LINE=".__LINE__."\n";
my $content_transfer_encoding='';my $content_disposition='';print "LINE=".__LINE__."\n";
my $date='';my $from='';my $keywords='';my $message_id='';print "LINE=".__LINE__."\n";
my $mime_version='';my $organization='';my $received='';print "LINE=".__LINE__."\n";
my $references='';my $reply_to='';my $resent_from='';print "LINE=".__LINE__."\n";
my $return_path='';my $sender='';my $subject='';my $body='';print "LINE=".__LINE__."\n";
my $to='';my $sendemail=0;my $done_warning=0;my $transport='';print "LINE=".__LINE__."\n";
my $head='';my $mail_sender='';my %mail_sender_defaults=();print "LINE=".__LINE__."\n";
my $mail_info=$_[0];my $ent='';print "LINE=".__LINE__."\n";
my $warn=1 if grep { lc($_) eq '__warn__' } @_;print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
#tie *debug, "Net::FullAuto::MemoryHandle";print "LINE=".__LINE__."\n";
if (ref $mail_info eq 'HASH') {
if (exists $mail_info->{Usage}) {
$usage=$mail_info->{Usage};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Usage})) {
$usage=$email_defaults{Usage};print "LINE=".__LINE__."\n";
}
if ($usage ne 'notify_on_error'
&& (caller(1))[3] eq 'FA_Core::handle_error') {
return 0;print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{Mail_Method}) {
$mail_method=$mail_info->{Mail_Method};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Method})) {
$mail_method=$email_defaults{Mail_Method};print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{Mail_Server}) {
$mail_server=$mail_info->{Mail_Server};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Server})) {
$mail_server=$email_defaults{Mail_Server};print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{Mail_Port}) {
$mail_port=$mail_info->{Mail_Port};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Port})) {
$mail_port=$email_defaults{Mail_Port};print "LINE=".__LINE__."\n";
}
if ($mail_method=~/smtp/i) {
if ($mail_server) {
if ($mail_port) {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server,
prot => $mail_port
});print "LINE=".__LINE__."\n";
} else {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server
});print "LINE=".__LINE__."\n";
}
}
}
$ent = MIME::Entity->build(Type => "multipart/mixed",
'X-Mailer' => undef);print "LINE=".__LINE__."\n";
if (exists $mail_info->{Bcc}) {
$ent->head->mime_attr(Bcc=>$mail_info->{Bcc});print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Bcc})) {
$ent->head->mime_attr(Bcc=>$email_defaults{Bcc});print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{Cc}) {
$ent->head->mime_attr(Cc=>$mail_info->{Cc});print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Cc})) {
$ent->head->mime_attr(Cc=>$email_defaults{Cc});print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{"Reply-To"}) {
$ent->head->mime_attr("Reply-To"=>$mail_info->{"Reply-To"});print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{"Reply-To"})) {
$ent->head->mime_attr("Reply-To"=>$email_defaults{"Reply-To"});print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{Priority}) {
$ent->head->mime_attr("Importance:"=>1);print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{From}) {
$ent->head->mime_attr(From=>$mail_info->{From});print "LINE=".__LINE__."\n";
} elsif ($email_defaults && ref $email_defaults eq 'HASH' &&
(exists $email_defaults{From})) {
$ent->head->mime_attr(From=>$email_defaults{From});print "LINE=".__LINE__."\n";
} else {
$ent->head->mime_attr(From=>
"$Net::FullAuto::FA_Core::progname".
"\@$Net::FullAuto::FA_Core::local_hostname");print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{Subject}) {
$ent->head->mime_attr(Subject=>$mail_info->{Subject});print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Subject})) {
$ent->head->mime_attr(Subject=>$email_defaults{Subject});print "LINE=".__LINE__."\n";
} elsif ($usage eq 'notify_on_error') {
if ($warn) {
$subject="WARNING! from $Net::FullAuto::FA_Core::local_hostname";print "LINE=".__LINE__."\n";
} else {
$subject="FATAL ERROR! from ".
$Net::FullAuto::FA_Core::local_hostname;print "LINE=".__LINE__."\n";
}
$ent->head->mime_attr(Subject=>$subject);print "LINE=".__LINE__."\n";
$ent->head->mime_attr("Importance:"=>1) unless $warn;print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{To}) {
if ($email_defaults &&
(exists $email_defaults{To})) {
$to=[];print "LINE=".__LINE__."\n";
push @{$to}, @{$email_defaults{To}};print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{To} && $mail_info->{To}) {
if (ref $mail_info->{To} eq 'ARRAY') {
if ($to) {
push @{$to}, @{$mail_info->{To}};print "LINE=".__LINE__."\n";
} else { $to=$mail_info->{To} }
} else {
if ($to) {
push @{$to}, $mail_info->{To};print "LINE=".__LINE__."\n";
} else { $to=$mail_info->{To} }
}
}
if (ref $to eq 'ARRAY') {
my $going_to='';print "LINE=".__LINE__."\n";
foreach my $item (@{$to}) {
if ($item=~/(__|\])USERNAME(\[|__)/i) {
$going_to.="$email_addresses{$username}\,"
if exists $email_addresses{$username};print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} $going_to.="$item\,";print "LINE=".__LINE__."\n";
} $to=substr($going_to,0,-1);print "LINE=".__LINE__."\n";
} elsif ($to=~/(__|\])USERNAME(\[|__)/i) {
$to=$email_addresses{$username}
if exists $email_addresses{$username};print "LINE=".__LINE__."\n";
}
$ent->head->mime_attr(To=>$to);print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{To})) {
$to=$email_defaults{To};print "LINE=".__LINE__."\n";
if (ref $to eq 'ARRAY') {
my $going_to='';print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} $going_to.="$item\,";print "LINE=".__LINE__."\n";
} $to=substr($going_to,0,-1);print "LINE=".__LINE__."\n";
} elsif ($to=~/(__|\])USERNAME(\[|__)/i) {
$to=$email_addresses{$username}
if exists $email_addresses{$username};print "LINE=".__LINE__."\n";
}
$ent->head->mime_attr(To=>$to);print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
}
if (exists $mail_info->{Attachments} &&
$mail_info->{Attachments}) {
if (ref $mail_info->{Attachments} eq 'ARRAY') {
foreach my $attach (@{$mail_info->{Attachments}}) {
if (ref $attach eq 'HASH') {
if (exists $attach->{Path}) {
unless (-f $attach->{Path}) {
die "Cannot locate attachment file: $attach";print "LINE=".__LINE__."\n";
}
} else {
die "ERROR: No attachment file specified";print "LINE=".__LINE__."\n";
}
unless (exists $attach->{Type}) {
if ($attach->{Path}=~/[.](\S+)$/) {
my $mt=$1;print "LINE=".__LINE__."\n";
if (exists $mimetypes{$mt}) {
$attach->{Type}=$mimetypes{$mt};print "LINE=".__LINE__."\n";
} else {
$attach->{Type}="text/plain";print "LINE=".__LINE__."\n";
}
} else {
$attach->{Type}="text/plain";print "LINE=".__LINE__."\n";
}
}
unless (exists $attach->{Encoding}) {
$attach->{Encoding}='base64';print "LINE=".__LINE__."\n";
}
$ent->attach(
Path => $attach->{Path},
Type => $attach->{Type},
Encoding => $attach->{Encoding},
);print "LINE=".__LINE__."\n";
}
if (-f $attach) {
my $type='';print "LINE=".__LINE__."\n";
if ($attach=~/[.](\S+)$/) {
my $mt=$1;print "LINE=".__LINE__."\n";
if (exists $mimetypes{$mt}) {
$type=$mimetypes{$mt};print "LINE=".__LINE__."\n";
} else {
$type="text/plain";print "LINE=".__LINE__."\n";
}
} else {
$type="text/plain";print "LINE=".__LINE__."\n";
}
$ent->attach(
Path => $attach,
Type => $type,
Encoding => 'base64',
);print "LINE=".__LINE__."\n";
} else {
die "Cannot locate attachment file: $attach";print "LINE=".__LINE__."\n";
}
}
}
}
} elsif ($email_defaults) {
$usage=$email_defaults{Usage}
if (exists $email_defaults{Usage});print "LINE=".__LINE__."\n";
if ($usage ne 'notify_on_error'
&& (caller(1))[3] eq 'FA_Core::handle_error') {
return 0;print "LINE=".__LINE__."\n";
}
$mail_server=$email_defaults{Mail_Server}
if exists $email_defaults{Mail_Server};print "LINE=".__LINE__."\n";
$mail_port =$email_defaults{Mail_Port}
if exists $email_defaults{Mail_Port};print "LINE=".__LINE__."\n";
$mail_method=$email_defaults{Mail_Method}
if exists $email_defaults{Mail_Method};print "LINE=".__LINE__."\n";
if ($mail_method=~/smtp/i) {
if ($mail_server) {
if ($mail_port) {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server,
port => $mail_port
});print "LINE=".__LINE__."\n";
} else {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server
});print "LINE=".__LINE__."\n";
}
}
}
$ent = MIME::Entity->build(Type => "multipart/mixed",
'X-Mailer' => undef);print "LINE=".__LINE__."\n";
if (exists $email_defaults{Bcc}) {
$ent->head->mime_attr(Bcc=>$email_defaults{Bcc});print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
}
if (exists $email_defaults{Cc}) {
$ent->head->mime_attr(Cc=>$email_defaults{Cc});print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
}
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});print "LINE=".__LINE__."\n";
}
if (exists $email_defaults{To}) {
$ent->head->mime_attr(To=>$email_defaults{To});print "LINE=".__LINE__."\n";
$sendemail=1;print "LINE=".__LINE__."\n";
}
} else {
warn "EMAIL ERROR - no email information defined $!";print "LINE=".__LINE__."\n";
$done_warning=1;print "LINE=".__LINE__."\n";
}
if (!$sendemail && !$done_warning) {
warn "EMAIL ERROR - no recipients defined $!";print "LINE=".__LINE__."\n";
}
if ($sendemail) {
if (ref $mail_info eq 'HASH') {
if (exists $mail_info->{Body}) {
$body=$mail_info->{Body};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Body})) {
$body=$email_defaults{Body};print "LINE=".__LINE__."\n";
} elsif (exists $mail_info->{Msg}) {
$body=$mail_info->{Msg};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Msg})) {
$body=$email_defaults{Msg};print "LINE=".__LINE__."\n";
} elsif (exists $mail_info->{Message}) {
$body=$mail_info->{Message};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Message})) {
$body=$email_defaults{Message};print "LINE=".__LINE__."\n";
}
} elsif ($email_defaults &&
(exists $email_defaults{Body})) {
$body=$email_defaults{Body};print "LINE=".__LINE__."\n";
} elsif ($email_defaults &&
(exists $email_defaults{Msg})) {
$body=$email_defaults{Msg};print "LINE=".__LINE__."\n";
}
$body=join '',@{$body} if ref $body eq 'ARRAY';print "LINE=".__LINE__."\n";
$ent->attach(Data => $body);print "LINE=".__LINE__."\n";
my $stdout_capture='';my $stderr_capture='';print "LINE=".__LINE__."\n";
while (1) {
my $eval_error='';print "LINE=".__LINE__."\n";
($stdout_capture,$stderr_capture)=Capture::Tiny::capture {
eval {
if ($transport) {
sendmail($ent,{transport=>$transport});print "LINE=".__LINE__."\n";
} else {
sendmail($ent);print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
$eval_error=$@;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($eval_error || $stdout_capture) {
if ($eval_error=~/^\s*$/ && $stdout_capture) {
$eval_error=$stdout_capture;print "LINE=".__LINE__."\n";
} elsif ($stdout_capture) {
$eval_error="$stdout_capture\n\n$eval_error";print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG $eval_error
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$eval_error,'';print "LINE=".__LINE__."\n";
} else {
die $eval_error;print "LINE=".__LINE__."\n";
}
} elsif (wantarray) {
return 'Mail sent OK.','','';print "LINE=".__LINE__."\n";
} elsif ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet) {
print "\nMail sent OK.\n";print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
}
}
$main::get_default_modules=sub {
if ($Net::FullAuto::cpu) {
my $idle=(split ',', $Net::FullAuto::cpu)[3];print "LINE=".__LINE__."\n";
$idle=~s/^\s*//;print "LINE=".__LINE__."\n";
$idle=~s/%.*$//;print "LINE=".__LINE__."\n";
my $cpyou=100-$idle;print "LINE=".__LINE__."\n";
if ($idle<20) {
my $die="FATAL ERROR - CPU Usage is too high\n"
." to run FullAuto safely.\n"
." CPU are Starttime ==> ${cpyou}%\n";print "LINE=".__LINE__."\n";
&handle_error($die);print "LINE=".__LINE__."\n";
}
}
print "GET_DEFAULT_MODULES\n";print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
unless (-f $Hosts{"__Master_${$}__"}{'FA_Core'}.'fa_global.pm') {
my $fd=$Hosts{"__Master_${$}__"}{'FA_Core'}.'fa_global.pm';print "LINE=".__LINE__."\n";
open (FD,">$fd") or &handle_error("Cannot open $fd: $!\n");print "LINE=".__LINE__."\n";
print FD "package fa_global;";print "LINE=".__LINE__."\n";
my $affero=<<END;print "LINE=".__LINE__."\n";
### OPEN SOURCE LICENSE - GNU AFFERO PUBLIC LICENSE Version 3.0 #######
#
# Net::FullAuto - Powerful Network Process Automation Software
# Copyright (C) 2000-2014 Brian M. Kelly
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero 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 Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public
# License along with this program. If not, see:
# <http://www.gnu.org/licenses/agpl.html>.
#
#######################################################################
END
print FD $affero."\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;";print "LINE=".__LINE__."\n";
close(FD);
}
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Defaults') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Defaults';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
$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);print "LINE=".__LINE__."\n";
$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
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Defaults';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$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
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_defaults.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track) unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Defaults/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $default_modules='';print "LINE=".__LINE__."\n";
my $status=$Net::FullAuto::FA_Core::bdb_once->db_get(
$username,$default_modules);print "LINE=".__LINE__."\n";
$default_modules||='';print "LINE=".__LINE__."\n";
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';print "LINE=".__LINE__."\n";
$default_modules=eval $default_modules;print "LINE=".__LINE__."\n";
$default_modules||='';print "LINE=".__LINE__."\n";
undef $Net::FullAuto::FA_Core::bdb_once;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::dbenv_once->close();print "LINE=".__LINE__."\n";
undef $Net::FullAuto::FA_Core::dbenv_once;print "LINE=".__LINE__."\n";
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}) {
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
$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);print "LINE=".__LINE__."\n";
$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
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$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
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_sets.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\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',
},
};print "LINE=".__LINE__."\n";
my $put_sref=
Data::Dump::Streamer::Dump($sref)->Out();print "LINE=".__LINE__."\n";
$status=$Net::FullAuto::FA_Core::bdb_once->db_put(
$username,$put_sref);print "LINE=".__LINE__."\n";
$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',
};print "LINE=".__LINE__."\n";
undef $Net::FullAuto::FA_Core::bdb_once;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::dbenv_once->close();print "LINE=".__LINE__."\n";
undef $Net::FullAuto::FA_Core::dbenv_once;print "LINE=".__LINE__."\n";
}
return $default_modules;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $set_default_sub=sub {
package set_default_sub;print "LINE=".__LINE__."\n";
my $default_set=shift;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $fa_global::FA_Secure.'Sets') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$fa_global::FA_Secure.'Sets';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_sets.db $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $mysets='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($username,$mysets);print "LINE=".__LINE__."\n";
$mysets=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$mysets=eval $mysets;
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
my $desc='';print "LINE=".__LINE__."\n";
my @sets=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$mysets}) {
push @sets,"SET Label: $key\n ".
"Description: ".$mysets->{$key}{'Description'};
}
return [ sort @sets ];print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $get_modules=sub {
use File::Path;print "LINE=".__LINE__."\n";
use File::Copy;print "LINE=".__LINE__."\n";
my $type=$_[0]||'';print "LINE=".__LINE__."\n";
unless ($type) {
$type=']P[';print "LINE=".__LINE__."\n";
my $ind=rindex $type,'fa_';print "LINE=".__LINE__."\n";
$type=substr($type,$ind+3,$ind+7);print "LINE=".__LINE__."\n";
}
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d "$fadir/Custom/$username/$type") {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
unless (-d "$fadir/Custom") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."\'$fadir/Custom\'";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d "$fadir/Custom/$username") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."\'$fadir/Custom/$username\'";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d "$fadir/Custom/$username/$type") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."\'$fadir/Custom/$username/$type\'";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('cp').'cp '.
"\'$fadir/Custom/fa_".lc($type).'.pm\' '.
"\'$fadir/Custom/$username/$type\'";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
"\'$fadir/Custom/$username/$type\'";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('ls')."ls -1 ".
"\'$fadir/Custom/$username/$type\' 2>&1";print "LINE=".__LINE__."\n";
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'sed'}) {
$sedpath=$Hosts{"__Master_${$}__"}{'sed'};print "LINE=".__LINE__."\n";
$sedpath.='/' if $sedpath!~/\/$/;print "LINE=".__LINE__."\n";
}
$cmd="$cmd | ${sedpath}sed -e \'s/^/stdout: /\' 2>&1";print "LINE=".__LINE__."\n";
my @return=();print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
foreach my $entry (split "\n",$stdout) {
next if $entry eq '.';print "LINE=".__LINE__."\n";
next if $entry eq '..';print "LINE=".__LINE__."\n";
next if -d $entry;print "LINE=".__LINE__."\n";
push @return, $entry;print "LINE=".__LINE__."\n";
}
return \@return;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $custmm=<<FIN;print "LINE=".__LINE__."\n";
__ __ __ __ _ _
| \\/ |___ _ _ _ _ | \\/ |___ __| |_ _| |___
| |\\/| / -_) ' \\ || | | |\\/| / _ \\/ _` | || | / -_)
|_| |_\\___|_||_\\_,_| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $custpm=<<FIN;print "LINE=".__LINE__."\n";
__ __ __ __ _ _
| \\/ |__ _ _ __ ___ | \\/ |___ __| |_ _| |___
| |\\/| / _` | '_ (_-< | |\\/| / _ \\/ _` | || | / -_)
|_| |_\\__,_| .__/__/ |_| |_\\___/\\__,_|\\_,_|_\\___|
|_|
FIN
my $custhm=<<FIN;print "LINE=".__LINE__."\n";
_ _ _ __ __ _ _
| || |___ __| |_ | \\/ |___ __| |_ _| |___
| __ / _ (_-< _| | |\\/| / _ \\/ _` | || | / -_)
|_||_\\___/__/\\__| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $custfm=<<FIN;print "LINE=".__LINE__."\n";
___ __ __ __ _ _
/ __|___ _ _ / _| | \\/ |___ __| |_ _| |___
| (__/ _ \\ ' \\| _| | |\\/| / _ \\/ _` | || | / -_)
\\___\\___/_||_|_| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $custcm=<<FIN;print "LINE=".__LINE__."\n";
___ _ __ __ _ _
/ __|___ __| |___ | \\/ |___ __| |_ _| |___
| (__/ _ \\/ _` / -_) | |\\/| / _ \\/ _` | || | / -_)
\\___\\___/\\__,_\\___| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $fabann=sub {
my $default_modules=$_[0] || $main::get_default_modules->();print "LINE=".__LINE__."\n";
my $type=$_[1]||'';print "LINE=".__LINE__."\n";
unless ($type) {
$type=']P[';print "LINE=".__LINE__."\n";
my $ind=rindex $type,'fa_';print "LINE=".__LINE__."\n";
$type=substr($type,$ind+3,$ind+7);print "LINE=".__LINE__."\n";
}
my $caps='';print "LINE=".__LINE__."\n";
if ($type eq 'code') {
$caps=$custcm;print "LINE=".__LINE__."\n";
} elsif ($type eq 'conf') {
$caps=$custfm;print "LINE=".__LINE__."\n";
} elsif ($type eq 'host') {
$caps=$custhm;print "LINE=".__LINE__."\n";
} elsif ($type eq 'maps') {
$caps=$custpm;print "LINE=".__LINE__."\n";
} else {
$caps=$custmm;print "LINE=".__LINE__."\n";
}
my $set='';print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\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):";print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fasetdef=sub {
package fasetdef;print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
#my $loc=substr($INC{'Net/FullAuto.pm'},
# 0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
#require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $fa_global::FA_Secure.'Defaults') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$fa_global::FA_Secure.'Defaults';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.
'Defaults',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => $progname."_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $default_modules='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get(
$username,$default_modules);print "LINE=".__LINE__."\n";
$default_modules||='';print "LINE=".__LINE__."\n";
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';print "LINE=".__LINE__."\n";
$default_modules=eval $default_modules;print "LINE=".__LINE__."\n";
$default_modules||={};print "LINE=".__LINE__."\n";
$default_modules->{'set'}='none';print "LINE=".__LINE__."\n";
if (-1<index ']S[','code') {
$default_modules->{'fa_code'}=
"Net/FullAuto/Custom/$username/".
"Code/]S[";print "LINE=".__LINE__."\n";
unless (exists $default_modules->{'fa_conf'}) {
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_maps.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';print "LINE=".__LINE__."\n";
}
} elsif (-1<index ']S[','conf') {
$default_modules->{'fa_conf'}=
"Net/FullAuto/Custom/$username/".
"Conf/]S[";print "LINE=".__LINE__."\n";
unless (exists $default_modules->{'fa_host'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_maps'}=
'Net/FullAuto/Distro/fa_maps.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';print "LINE=".__LINE__."\n";
}
} elsif (-1<index ']S[','host') {
$default_modules->{'fa_host'}=
"Net/FullAuto/Custom/$username/".
"Host/]S[";print "LINE=".__LINE__."\n";
unless (exists $default_modules->{'fa_maps'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_maps'}=
'Net/FullAuto/Distro/fa_maps.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';print "LINE=".__LINE__."\n";
}
} elsif (-1<index ']S[','maps') {
$default_modules->{'fa_maps'}=
"Net/FullAuto/Custom/$username/".
"Maps/]S[";print "LINE=".__LINE__."\n";
unless (exists $default_modules->{'fa_menu'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';print "LINE=".__LINE__."\n";
}
} else {
$default_modules->{'fa_menu'}=
"Net/FullAuto/Custom/$username/".
"Menu/]S[";print "LINE=".__LINE__."\n";
unless (exists $default_modules->{'fa_menu'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_maps'}=
'Net/FullAuto/Distro/fa_maps.pm';print "LINE=".__LINE__."\n";
}
}
my $put_dref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put(
$username,$put_dref);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
return "Finished Default Module";print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $default_sets_banner_sub=sub {
package default_sets_banner;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
use Data::Dump::Streamer;print "LINE=".__LINE__."\n";
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
my $dfbann=<<FIN;print "LINE=".__LINE__."\n";
___ _ _ _ _ ___ __ _ _
| __| _| | | /_\\ _ _| |_ ___ | \\ ___ / _|__ _ _ _| | |_ ___
| _| || | | |/ _ \\ || | _/ _ \\ | |) / -_) _/ _` | || | | _(_-<
|_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/ |___/\\___|_| \\__,_|\\_,_|_|\\__/__/
FIN
unless (-d $fa_global::FA_Secure.'Sets') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$fa_global::FA_Secure.'Sets';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $sdbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Sets',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');print "LINE=".__LINE__."\n";
my $sbdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $sdbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$sbdb = BerkeleyDB::Btree->new(
-Filename => $progname."_sets.db",
-Flags => DB_CREATE,
-Env => $sdbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ${progname}_sets.db ".
$BerkeleyDB::Error."\n";print "LINE=".__LINE__."\n";
}
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $mysets='';print "LINE=".__LINE__."\n";
my $status=$sbdb->db_get($username,$mysets);print "LINE=".__LINE__."\n";
$mysets=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$mysets=eval $mysets;print "LINE=".__LINE__."\n";
undef $sbdb;print "LINE=".__LINE__."\n";
$sdbenv->close();print "LINE=".__LINE__."\n";
undef $sdbenv;print "LINE=".__LINE__."\n";
my $default_modules=$_[0] || $main::get_default_modules->();print "LINE=".__LINE__."\n";
my $set=$default_modules->{'set'};print "LINE=".__LINE__."\n";
my $spc=length $set;print "LINE=".__LINE__."\n";
$spc=pack("A$spc",'');print "LINE=".__LINE__."\n";
my $banner=$dfbann." ** 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";print "LINE=".__LINE__."\n";
return $banner;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fa_congrats=<<END;print "LINE=".__LINE__."\n";
___ _ _ _ _ _
/ __|___ _ _ __ _ _ _ __ _| |_ _ _| |__ _| |_(_)___ _ _ __| |
| (__/ _ \\ ' \\/ _` | '_/ _` | _| || | / _` | _| / _ \\ ' \\(_-<_|
\\___\\___/_||_\\__, |_| \\__,_|\\__|\\_,_|_\\__,_|\\__|_\\___/_||_/__(_)
|___/
You have QUICKLY gotten started with FullAuto! The goal of this new
user wizard experience was to acquaint you both with managing your
automation code files, and demonstrating how FullAuto wizards and Menus
(using Term::Menus) can break down and make the most complex and difficult
tasks EASY! Imagine transforming ALL the processes in your organization
into self-documenting presentations that anyone can follow - and that
unlike ordinary documentation, actually DOES STUFF! It can be achieved
with FullAuto! But only the surface has been scratched - FullAuto
is really all about AUTOMATION - and we will get into that NEXT. THANKS!
END
my $setup_new_user11=sub{
my %setup_new_user11=(
Name => 'setup_new_user11',
Item_1 => {
Text => 'Continue with AUTOMATING *any* process with FullAuto!',
},
Item_2 => {
Text => "Exit FullAuto (Setup is COMPLETE! Use 'fa' to run FullAuto)",
},
Banner => $fa_congrats,
);print "LINE=".__LINE__."\n";
return \%setup_new_user11;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $cacomm_sub=sub {
my $new_user_flag=0;my $item_2={};print "LINE=".__LINE__."\n";
if (defined $main::new_user_flag and $main::new_user_flag) {
$item_2={
Text => "No",
Result => $setup_new_user11,
},
} else {
$item_2={
Text => "No ( FullAuto [fa --set] will EXIT )",
},
}
my %cacomm=(
Name => 'cacomm',
Item_1 => {
Text => "YES",
Result => sub {
package del_sets;print "LINE=".__LINE__."\n";
$main::get_default_modules->()
unless defined $Net::FullAuto::FA_Core::fa_global;print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
#my $loc=substr($INC{'Net/FullAuto.pm'},
# 0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')
+1,-3);print "LINE=".__LINE__."\n";
#require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $fa_global::FA_Secure.'Defaults') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m.
$Hosts{"__Master_".$$."__"}{'FA_Secure'}.
'Defaults';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.
'Defaults',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => $progname.
"_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->(
'chmod')."chmod -Rv $mode ".
"${fa_global::FA_Secure}.Defaults/*";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr &&
-1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $default_modules='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get(
$username,$default_modules);print "LINE=".__LINE__."\n";
$default_modules||='';print "LINE=".__LINE__."\n";
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';print "LINE=".__LINE__."\n";
$default_modules=eval $default_modules;print "LINE=".__LINE__."\n";
$default_modules||={};print "LINE=".__LINE__."\n";
$default_modules->{'set'}='none';print "LINE=".__LINE__."\n";
$default_modules->{'fa_code'}=
"Net/FullAuto/Custom/$username/".
"Code/]P[{cacode}";print "LINE=".__LINE__."\n";
$default_modules->{'fa_conf'}=
"Net/FullAuto/Custom/$username/".
"Conf/]P[{caconf}";print "LINE=".__LINE__."\n";
$default_modules->{'fa_host'}=
"Net/FullAuto/Custom/$username/".
"Host/]P[{cahost}";print "LINE=".__LINE__."\n";
$default_modules->{'fa_maps'}=
"Net/FullAuto/Custom/$username/".
"Maps/]P[{camaps}";print "LINE=".__LINE__."\n";
$default_modules->{'fa_menu'}=
"Net/FullAuto/Custom/$username/".
"Menu/]P[{camenu}";print "LINE=".__LINE__."\n";
my $put_dref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put(
$username,$put_dref);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
if (defined $main::new_user_flag &&
$main::new_user_flag) {
return $setup_new_user11;print "LINE=".__LINE__."\n";
}
return "Finished Defining Defaults";print "LINE=".__LINE__."\n";
}
},
Item_2 => $item_2,
Banner => sub {
my $custnd=<<FIN;print "LINE=".__LINE__."\n";
_ _ ___ __ _ _
| \\| |_____ __ __ | \\ ___ / _|__ _ _ _| | |_ ___
| .` / -_) V V / | |) / -_) _/ _` | || | | _(_-< o
|_|\\_\\___|\\_/\\_/ |___/\\___|_| \\__,_|\\_,_|_|\\__/__/ o
FIN
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
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?:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%cacomm;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $camenu_sub=sub {
my %camenu=(
Name => 'camenu',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => $cacomm_sub->(),
},
Banner => sub {
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
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:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%camenu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $camaps_sub=sub {
my %camaps=(
Name => 'camaps',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Maps'),
Result => $camenu_sub->(),
},
Banner => sub {
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
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:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%camaps;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $cahost_sub=sub {
my %cahost=(
Name => 'cahost',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => $camaps_sub->(),
},
Banner => sub {
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
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:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%cahost;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $caconf_sub=sub {
my %caconf=(
Name => 'caconf',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => $cahost_sub->(),
},
Banner => sub {
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
return " Code => Net/FullAuto/Custom/$username/".
"]P[{cacode}\n\n".
"$custfm Please select a fa_conf[.*].pm ".
"module:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%caconf;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $cacode_sub=sub {
my %cacode=(
Name => 'cacode',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Code'),
Result => $caconf_sub->(),
},
Banner => "$custcm Please select a fa_code[.*].pm ".
"module:",
);print "LINE=".__LINE__."\n";
return \%cacode;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $define_module_from_viewdef_sub=sub {
my %define_module_from_viewdef=(
Name => 'define_module_from_viewdef',
Item_1 => {
Text => ']C[',
Convey => $get_modules,
Result => $fasetdef,
},
Banner => $fabann,
);print "LINE=".__LINE__."\n";
return \%define_module_from_viewdef;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $vdbanner=sub {
my $dfbann=<<FIN;print "LINE=".__LINE__."\n";
___ _ _ _ _ ___ __ _ _
| __| _| | | /_\\ _ _| |_ ___ | \\ ___ / _|__ _ _ _| | |_ ___
| _| || | | |/ _ \\ || | _/ _ \\ | |) / -_) _/ _` | || | | _(_-<
|_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/ |___/\\___|_| \\__,_|\\_,_|_|\\__/__/
FIN
my $default_modules=$_[0] || $main::get_default_modules->();print "LINE=".__LINE__."\n";
my $banner=$dfbann;print "LINE=".__LINE__."\n";
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
$banner.=" ** NO DEFAULT SET DEFINED **\n\n";print "LINE=".__LINE__."\n";
}
$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";print "LINE=".__LINE__."\n";
return $banner;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $viewdefaults_sub=sub {
my %viewdefaults=(
Name => 'viewdefaults',
Item_1 => {
Text => "Change ALL Defaults",
Result => $cacode_sub->($_[0]),
},
Item_2 => {
Text => "Change Default ]C[",
Convey => ['fa_code','fa_conf','fa_host',
'fa_maps','fa_menu'],
Result => $define_module_from_viewdef_sub->($_[0]),
},
Banner => $vdbanner->($_[0]),
);print "LINE=".__LINE__."\n";
return \%viewdefaults;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $defaultsettings_sub=sub {
my %defaultsettings=(
Name => 'defaultsettings',
Item_1 => {
Text =>
"View Defaults when Default Set equals \'none\'",
Result => $viewdefaults_sub->($_[0]),
},
Item_2 => {
Text => "Change ALL Defaults",
Result => $cacode_sub->($_[0]),
},
Item_3 => {
Text => "Change Default ]C[",
Convey => ['fa_code','fa_conf','fa_host',
'fa_maps','fa_menu'],
},
Banner => $default_sets_banner_sub->($_[0]),
);print "LINE=".__LINE__."\n";
return \%defaultsettings;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $admin_defaults_sub=sub {
my $default_modules=$main::get_default_modules->();print "LINE=".__LINE__."\n";
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
return $viewdefaults_sub->($default_modules);print "LINE=".__LINE__."\n";
} else {
return $defaultsettings_sub->($default_modules);
}
};print "LINE=".__LINE__."\n";
my $defaults_sub=sub {
my $default_modules=$_[0] || $main::get_default_modules->();
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
my $selection=Menu($viewdefaults_sub->($default_modules));print "LINE=".__LINE__."\n";
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults') ||
($selection eq 'Finished Default Module')) {
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
}
} else {
my $selection=Menu($defaultsettings_sub->($default_modules));print "LINE=".__LINE__."\n";
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults')) {
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
my $define_modules_commit_sub=sub {
my %define_modules_commit=(
Name => 'define_modules_commit',
Item_1 => {
Text => "YES",
Result => sub {
package set_default_sub;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
use Data::Dump::Streamer;print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
#my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
#require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $fa_global::FA_Secure.'Sets') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$fa_global::FA_Secure.'Sets';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_sets.db $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod').
"chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $mysets='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($username,$mysets);print "LINE=".__LINE__."\n";
$mysets=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$mysets=eval $mysets;print "LINE=".__LINE__."\n";
my $ph="Net/FullAuto/Custom/$username/";print "LINE=".__LINE__."\n";
$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}"
};print "LINE=".__LINE__."\n";
my $put_mref=
Data::Dump::Streamer::Dump($mysets)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($username,$put_mref);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return "Finished Defining Set";print "LINE=".__LINE__."\n";
},
},
Item_2 => {
Text => "No ( FullAuto [fa --set] will EXIT )",
},
Banner => sub {
my $custns=<<FIN;print "LINE=".__LINE__."\n";
_ _ ___ _
| \\| |_____ __ __ / __| ___| |_
| .` / -_) V V / \\__ \\/ -_) _| o
|_|\\_\\___|\\_/\\_/ |___/\\___|\\__| o
FIN
my $spc=length $main::setname;print "LINE=".__LINE__."\n";
$spc=pack("A$spc",'');print "LINE=".__LINE__."\n";
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 )?:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%define_modules_commit;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $define_modules_menu_fa_menu_sub=sub {
my %define_modules_menu_fa_menu=(
Name => 'define_modules_menu_fa_menu',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => $define_modules_commit_sub->(),
},
Banner => sub {
my $spc=length $main::setname;print "LINE=".__LINE__."\n";
$spc=pack("A$spc",'');print "LINE=".__LINE__."\n";
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:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%define_modules_menu_fa_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $define_modules_menu_fa_maps_sub=sub {
my %define_modules_menu_fa_maps=(
Name => 'define_modules_menu_fa_maps',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Maps'),
Result => $define_modules_menu_fa_menu_sub->(),
},
Banner => sub {
my $spc=length $main::setname;print "LINE=".__LINE__."\n";
$spc=pack("A$spc",'');print "LINE=".__LINE__."\n";
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:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%define_modules_menu_fa_maps;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $define_modules_menu_fa_host_sub=sub {
my %define_modules_menu_fa_host=(
Name => 'define_modules_menu_fa_host',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => $define_modules_menu_fa_maps_sub->(),
},
Banner => sub {
my $spc=length $main::setname;print "LINE=".__LINE__."\n";
$spc=pack("A$spc",'');print "LINE=".__LINE__."\n";
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:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%define_modules_menu_fa_host;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $define_modules_menu_fa_conf_sub=sub {
my %define_modules_menu_fa_conf=(
Name => 'define_modules_menu_fa_conf',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => $define_modules_menu_fa_host_sub->(),
},
Banner => sub {
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n\n".
"$custfm Please select a fa_conf[.*].pm ".
"module:";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%define_modules_menu_fa_conf;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $define_modules_menu_fa_code_sub=sub {
my %define_modules_menu_fa_code=(
Name => 'define_modules_menu_fa_code',
Item_1 => {
Text => ']C[',
Convey => sub {
use File::Path;print "LINE=".__LINE__."\n";
use File::Copy;print "LINE=".__LINE__."\n";
while (1) {
print "\n\n\n Please type the name\n".
" for the new Set: ";print "LINE=".__LINE__."\n";
$main::setname=<STDIN>;print "LINE=".__LINE__."\n";
chomp($main::setname);print "LINE=".__LINE__."\n";
my $sets=$set_default_sub->();print "LINE=".__LINE__."\n";
my %sets=();print "LINE=".__LINE__."\n";
foreach my $set (@{$sets}) {
$set=~s/^.*Label:\s+(.*?)\s+.*$/$1/s;print "LINE=".__LINE__."\n";
$sets{$set}='';print "LINE=".__LINE__."\n";
}
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?";print "LINE=".__LINE__."\n";
my $ans=Term::Menus::pick(['yes','no'],$bann);print "LINE=".__LINE__."\n";
if ($ans eq 'no') {
next;print "LINE=".__LINE__."\n";
} else { last }
} elsif ($main::setname=~/^\s*$/) {
next;print "LINE=".__LINE__."\n";
} else { last }
}
print "\n\n\n Please type the Description\n".
" for the new Set: ";print "LINE=".__LINE__."\n";
$main::desc=<STDIN>;print "LINE=".__LINE__."\n";
chomp($main::desc);print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
unless (-d "$fadir/Custom/$username/Code") {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
unless (-d "$fadir/Custom") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."$fadir/Custom";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d "$fadir/Custom/$username") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."$fadir/Custom/$username";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d "$fadir/Custom/$username/Code") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."$fadir/Custom/$username/Code";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('cp').'cp '.
"$fadir/Custom/fa_code.pm ".
"$fadir/Custom/$username/Code";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod').
"chmod -Rv $mode ".
"$fadir/Custom/$username/Code/*";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
}
opendir(DIR,"$fadir/Custom/$username/Code");print "LINE=".__LINE__."\n";
my @xfiles = readdir(DIR);print "LINE=".__LINE__."\n";
my @return=();print "LINE=".__LINE__."\n";
closedir(DIR);print "LINE=".__LINE__."\n";
foreach my $entry (@xfiles) {
next if $entry eq '.';print "LINE=".__LINE__."\n";
next if $entry eq '..';print "LINE=".__LINE__."\n";
next if -d $entry;print "LINE=".__LINE__."\n";
push @return, $entry;print "LINE=".__LINE__."\n";
}
return @return;print "LINE=".__LINE__."\n";
},
Result => $define_modules_menu_fa_conf_sub->(),
},
Banner => sub {
# my $custcm=<<FIN;print "LINE=".__LINE__."\n";
# ___ _ __ __ _ _
# / __|___ __| |___ | \\/ |___ __| |_ _| |___
# | (__/ _ \\/ _` / -_) | |\\/| / _ \\/ _` | || | / -_)
# \\___\\___/\\__,_\\___| |_| |_\\___/\\__,_|\\_,_|_\\___|
#
#
#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";print "LINE=".__LINE__."\n";
},
);print "LINE=".__LINE__."\n";
return \%define_modules_menu_fa_code;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $delete_sets_menu_sub=sub {
my %delete_sets_menu=(
Name => 'delete_sets_menu',
Item_1 => {
Text => "]C[",
Convey => sub {
my $arr=$set_default_sub->();print "LINE=".__LINE__."\n";
my @ret=();print "LINE=".__LINE__."\n";
foreach my $ar (@{$arr}) {
push @ret,"$ar\n\n";print "LINE=".__LINE__."\n";
}
return @ret;print "LINE=".__LINE__."\n";
},
Result => sub {
package del_sets;print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
my $res='';print "LINE=".__LINE__."\n";
if ("]S[") {
$res="]S[";print "LINE=".__LINE__."\n";
if (substr($res,0,1) eq '[') {
$res=eval $res;print "LINE=".__LINE__."\n";
}
}
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
#my $loc=substr($INC{'Net/FullAuto.pm'},
# 0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')
+1,-3);print "LINE=".__LINE__."\n";
#require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $fa_global::FA_Secure.'Defaults') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m.$fa_global::FA_Secure.'Defaults';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.
'Defaults',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => $progname.
"_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=
&Net::FullAuto::FA_Core::find_berkeleydb_utils(
'recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Defaults';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename => $progname."_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_defaults.db ".
$BerkeleyDB::Error."\n";print "LINE=".__LINE__."\n";
}
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->(
'chmod')."chmod -Rv $mode ".
"${fa_global::FA_Secure}Defaults/*";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr &&
-1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $default_modules='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get(
$username,$default_modules);print "LINE=".__LINE__."\n";
$default_modules||='';print "LINE=".__LINE__."\n";
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,
'$HASH';print "LINE=".__LINE__."\n";
$default_modules=eval $default_modules;print "LINE=".__LINE__."\n";
$default_modules||='';print "LINE=".__LINE__."\n";
$mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $fa_global::FA_Secure.'Sets') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m.$fa_global::FA_Secure.'Sets';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $sdbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Sets',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');print "LINE=".__LINE__."\n";
my $sbdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $sdbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=
&Net::FullAuto::FA_Core::find_berkeleydb_utils(
'recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$sbdb = BerkeleyDB::Btree->new(
-Filename => $progname."_sets.db",
-Flags => DB_CREATE,
-Env => $sdbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_sets.db ".
$BerkeleyDB::Error."\n";print "LINE=".__LINE__."\n";
}
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->(
'chmod')."chmod -Rv $mode ".
"${fa_global::FA_Secure}Sets/*";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr &&
-1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $mysets='';print "LINE=".__LINE__."\n";
$status=$sbdb->db_get(
$username,$mysets);print "LINE=".__LINE__."\n";
$mysets=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$mysets=eval $mysets;print "LINE=".__LINE__."\n";
foreach my $set (@{$res}) {
$set=~
s/^.*Label:\s+(.*?)\s+.*$/$1/s;print "LINE=".__LINE__."\n";
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\')";print "LINE=".__LINE__."\n";
my $ans=Term::Menus::pick(
['yes','no'],$ban);print "LINE=".__LINE__."\n";
if ($ans eq 'no') {
next;print "LINE=".__LINE__."\n";
} else {
$default_modules->{'set'}=
'none';print "LINE=".__LINE__."\n";
}
}
delete $mysets->{$set};print "LINE=".__LINE__."\n";
}
my $put_dref=
Data::Dump::Streamer::Dump(
$mysets)->Out();print "LINE=".__LINE__."\n";
$status=
$sbdb->db_put($username,$put_dref);print "LINE=".__LINE__."\n";
my $put_fref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();print "LINE=".__LINE__."\n";
$status=
$bdb->db_put($username,$put_fref);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
undef $sbdb;print "LINE=".__LINE__."\n";
$sdbenv->close();print "LINE=".__LINE__."\n";
undef $sdbenv;print "LINE=".__LINE__."\n";
return 'Finished Deleting Set';print "LINE=".__LINE__."\n";
},
},
Select => 'Many',
Banner => sub {
my $custds=<<FIN;print "LINE=".__LINE__."\n";
___ _ _ ___ _
| \\ ___| |___| |_ ___ / __| ___| |_ ___
| |) / -_) / -_) _/ -_) \\__ \\/ -_) _(_-<
|___/\\___|_\\___|\\__\\___| |___/\\___|\\__/__/
FIN
return "$custds ".
"Please Select one or more Sets to Delete:"
},
);print "LINE=".__LINE__."\n";
return \%delete_sets_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $manage_modules_menu_sub=sub {
my $default_modules=$_[0] || $main::get_default_modules->();print "LINE=".__LINE__."\n";
$default_modules->{'set'}||='none';print "LINE=".__LINE__."\n";
my $current_default_set=$default_modules->{'set'};print "LINE=".__LINE__."\n";
my $mm_banner=" Please Select a Module Set Operation:\n\n";print "LINE=".__LINE__."\n";
if ($current_default_set eq 'none') {
$mm_banner.=" ** NO DEFAULT SET DEFINED **\n";print "LINE=".__LINE__."\n";
} else {
$mm_banner.=
" ** DEFAULT SET -> $current_default_set **\n";print "LINE=".__LINE__."\n";
}
my %manage_modules_menu=(
Name => '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_sub->(),
},
Item_4 => {
Text => 'Export Module Set/Components',
},
Item_5 => {
Text => 'Import Module Set/Components',
},
Banner => $mm_banner
);print "LINE=".__LINE__."\n";
return \%manage_modules_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $set_default_menu_in_db_sub=sub {
package set_default_menu_in_db_sub;print "LINE=".__LINE__."\n";
no strict 'subs';print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
use File::Path;print "LINE=".__LINE__."\n";
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
require "$loc/fa_global.pm";print "LINE=".__LINE__."\n";
my $selection=']S[';print "LINE=".__LINE__."\n";
$selection=~s/^.*Label:\s+(.*?)\s+.*$/$1/s;print "LINE=".__LINE__."\n";
$selection='none' if -1<index $selection,"'none'";print "LINE=".__LINE__."\n";
my $default_modules=$main::get_default_modules->();print "LINE=".__LINE__."\n";
$default_modules->{'set'}=$selection;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Defaults',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils(
'recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_$\{$\}__"}{'FA_Secure'}.
'Defaults';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_defaults.db $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
my $put_dref=
Data::Dump::Streamer::Dump($default_modules)->Out();print "LINE=".__LINE__."\n";
my $status=$bdb->db_put($username,$put_dref);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
print "\n\n Default Module Set is now -> \'$selection\'.\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock(9361);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::cleanup();print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $set_default_menu_sub=sub {
my $default_modules=$_[0] || $main::get_default_modules->();print "LINE=".__LINE__."\n";
$default_modules->{'set'}||='none';print "LINE=".__LINE__."\n";
my $current_default_set=$default_modules->{'set'};print "LINE=".__LINE__."\n";
my $sdf_banner=" Please Select a Default Module Set:\n\n";print "LINE=".__LINE__."\n";
my $clearoption='';print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
if ($current_default_set eq 'none') {
$sdf_banner.=" ** NO DEFAULT SET DEFINED **\n";print "LINE=".__LINE__."\n";
$clearoption="Keep as 'none'\n\n";print "LINE=".__LINE__."\n";
} else {
$sdf_banner.=
" ** DEFAULT SET -> $current_default_set **\n";print "LINE=".__LINE__."\n";
$clearoption="Set to 'none'\n\n";print "LINE=".__LINE__."\n";
}
my %set_default_menu=(
Name => 'set_default_menu',
Item_1 => {
Text => $clearoption,
Result => $set_default_menu_in_db_sub,
},
Item_2 => {
Text => "]C[\n ".
"Username: $username\n\n",
Default => "SET Label: $current_default_set",
Convey => $set_default_sub->($current_default_set),
Result => $set_default_menu_in_db_sub,
},
Banner => $sdf_banner
);print "LINE=".__LINE__."\n";
return \%set_default_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $insert_comp_sub=sub {
my $item_to_insert_around="]T[{select_how_to_insert}";print "LINE=".__LINE__."\n";
$item_to_insert_around=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my $comp_dir="]!P[{select_component_dir}";print "LINE=".__LINE__."\n";
$comp_dir=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my $comp_to_import="]!P[{select_comp_to_import}";print "LINE=".__LINE__."\n";
$comp_to_import=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
$comp_to_import=~s/\s+at Line.*$//;print "LINE=".__LINE__."\n";
my $local_code=&Net::FullAuto::FA_Core::fa_set;print "LINE=".__LINE__."\n";
require PPI;print "LINE=".__LINE__."\n";
my %fa_subs=();print "LINE=".__LINE__."\n";
foreach my $sub (keys %main::fa_subs) {
$fa_subs{$main::fa_subs{$sub}->[0]}=$main::fa_subs{$sub}->[1];print "LINE=".__LINE__."\n";
}
my %loc_subs=();print "LINE=".__LINE__."\n";
my $local_doc = PPI::Document->new($local_code->{lc($comp_dir)});print "LINE=".__LINE__."\n";
my $subs_ref =
$local_doc->find(
sub { $_[1]->isa('PPI::Statement::Sub') });print "LINE=".__LINE__."\n";
my %refs=();print "LINE=".__LINE__."\n";
foreach my $ref (@$subs_ref) {
unless ($ref->forward) {
$loc_subs{ $ref->location->[0] } =
[ $ref->name, $ref->content ];print "LINE=".__LINE__."\n";
$refs{$ref->name}=$ref;print "LINE=".__LINE__."\n";
}
}
my $replace_flag=0;print "LINE=".__LINE__."\n";
my $where='above';print "LINE=".__LINE__."\n";
if ($item_to_insert_around=~s/^Replace\s+(.*)$/$1/) {
$replace_flag=1;print "LINE=".__LINE__."\n";
} else {
$item_to_insert_around=~s/^Insert (above|below)\s+(.*?)\s+at Line.*$/$2/;print "LINE=".__LINE__."\n";
$where=$1;print "LINE=".__LINE__."\n";
}
if ($where eq 'above') {
my $lines=PPI::Document->new(\"\n\n");print "LINE=".__LINE__."\n";
my $import_sub=PPI::Document->new(\$fa_subs{$comp_to_import});print "LINE=".__LINE__."\n";
$refs{$item_to_insert_around}->__insert_before($import_sub);print "LINE=".__LINE__."\n";
$refs{$item_to_insert_around}->__insert_before($lines);print "LINE=".__LINE__."\n";
if ($replace_flag) {
while (my $ws=$refs{$item_to_insert_around}->next_token) {
last if $ws ne "\n";print "LINE=".__LINE__."\n";
$ws->remove;print "LINE=".__LINE__."\n";
}
$refs{$item_to_insert_around}->remove if $replace_flag;print "LINE=".__LINE__."\n";
}
} else {
my $import_sub=PPI::Document->new(\$fa_subs{$comp_to_import});print "LINE=".__LINE__."\n";
$refs{$item_to_insert_around}->__insert_after($import_sub);print "LINE=".__LINE__."\n";
my $lines=PPI::Document->new(\"\n\n");print "LINE=".__LINE__."\n";
$refs{$item_to_insert_around}->__insert_after($lines);print "LINE=".__LINE__."\n";
}
$local_doc->save($local_code->{lc($comp_dir)});print "LINE=".__LINE__."\n";
return '{admin}<'
};print "LINE=".__LINE__."\n";
my $select_location_to_insert_comp_sub=sub {
my $insert_item="]T[{select_comp_to_import}";print "LINE=".__LINE__."\n";
$insert_item=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my $i_item=$insert_item;print "LINE=".__LINE__."\n";
$i_item=~s/\s*at Line.*//;print "LINE=".__LINE__."\n";
my $compon="]!P[{select_component_dir}";print "LINE=".__LINE__."\n";
$compon=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my $local_code=&Net::FullAuto::FA_Core::fa_set;print "LINE=".__LINE__."\n";
require PPI;print "LINE=".__LINE__."\n";
require Data::Dump::Streamer;print "LINE=".__LINE__."\n";
my %loc_subs=();print "LINE=".__LINE__."\n";
my $local_doc = PPI::Document->new($local_code->{lc($compon)});print "LINE=".__LINE__."\n";
my $subs_ref =
$local_doc->find(
sub { $_[1]->isa('PPI::Statement::Sub') });print "LINE=".__LINE__."\n";
my $replace_flag=0;print "LINE=".__LINE__."\n";
foreach my $ref (@$subs_ref) {
unless ($ref->forward) {
if ($ref->name eq $i_item) {
$replace_flag=1;print "LINE=".__LINE__."\n";
}
$loc_subs{ $ref->location->[0] } =
[ $ref->name, $ref->content ];print "LINE=".__LINE__."\n";
}
}
my @comp=();print "LINE=".__LINE__."\n";
my $ll=0;my $l=0;print "LINE=".__LINE__."\n";
foreach my $loc (keys %main::loc_subs) {
$l=length $loc_subs{$loc}->[0];print "LINE=".__LINE__."\n";
$ll=$l if $l>$ll;print "LINE=".__LINE__."\n";
}
$ll+=3;print "LINE=".__LINE__."\n";
foreach my $loc (sort numerically keys %loc_subs) {
push @comp, "Insert above ".sprintf "%-${ll}s %-s",
$loc_subs{$loc}->[0]," at Line $loc";print "LINE=".__LINE__."\n";
}
my $last=$comp[$#comp];print "LINE=".__LINE__."\n";
$last=~s/ above / below /;print "LINE=".__LINE__."\n";
push @comp, $last;print "LINE=".__LINE__."\n";
if ($replace_flag) {
unshift @comp, "Replace $i_item";print "LINE=".__LINE__."\n";
}
my $banner='';print "LINE=".__LINE__."\n";
if ($compon eq 'Code') {
$banner=" Select how to insert CCB - $i_item";print "LINE=".__LINE__."\n";
} elsif ($compon eq 'Host') {
$banner=" Select how to insert CHB - $i_item";print "LINE=".__LINE__."\n";
} elsif ($compon eq 'Conf') {
$banner=" Select how to insert CCI - $i_item";print "LINE=".__LINE__."\n";
} elsif ($compon eq 'Maps') {
$banner=" Select how to insert CMI - $i_item";print "LINE=".__LINE__."\n";
} else {
$banner=" Select how to insert CMB - $i_item";print "LINE=".__LINE__."\n";
}
my %select_how_to_insert=(
Name => 'select_how_to_insert',
Item_1 => {
Text => ']C[',
Convey => \@comp,
Result => $insert_comp_sub,
},
Banner => $banner,
);print "LINE=".__LINE__."\n";
return \%select_how_to_insert,
};print "LINE=".__LINE__."\n";
my $select_file_components_to_import_sub=sub {
my $file_comp="]T[{select_user_comp_file}";print "LINE=".__LINE__."\n";
my $user="]!P[{remote_fa_users}";print "LINE=".__LINE__."\n";
$user=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my $compon="]!P[{select_component_dir}";print "LINE=".__LINE__."\n";
$compon=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=$main::remote_host->cmd(
'/usr/local/bin/fullauto --cat '.
$file_comp);print "LINE=".__LINE__."\n";
if ($stderr) {
$main::remote_host->close();print "LINE=".__LINE__."\n";
$stderr=~s/Connection cl/ Connection cl/s;print "LINE=".__LINE__."\n";
$stderr=~s/^\s*//s;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines,"\n\n ",$stderr,
" Press ANY KEY to return to the Admin Menu\n";print "LINE=".__LINE__."\n";
alarm 120;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode('cbreak');print "LINE=".__LINE__."\n";
# Turn off controls keys
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';print "LINE=".__LINE__."\n";
$key = ReadKey(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');print "LINE=".__LINE__."\n";
return '{admin}<';print "LINE=".__LINE__."\n";
} else {
require PPI;print "LINE=".__LINE__."\n";
require Data::Dump::Streamer;print "LINE=".__LINE__."\n";
%main::fa_subs=();print "LINE=".__LINE__."\n";
my $remote_doc = PPI::Document->new(\$stdout);print "LINE=".__LINE__."\n";
my $subs_ref =
$remote_doc->find( sub { $_[1]->isa('PPI::Statement::Sub') });print "LINE=".__LINE__."\n";
foreach my $ref (@$subs_ref) {
unless ($ref->forward) {
$main::fa_subs{ $ref->location->[0] } =
[ $ref->name, $ref->content ];print "LINE=".__LINE__."\n";
}
}
my $banner='';print "LINE=".__LINE__."\n";
if ($compon eq 'Code') {
$banner=" Select CCB (Custom Code Block) to Import";print "LINE=".__LINE__."\n";
} elsif ($compon eq 'Host') {
$banner=" Select CHB (Custom Host Block) to Import";print "LINE=".__LINE__."\n";
} elsif ($compon eq 'Conf') {
$banner=" Select CCI (Custom Config Item) to Import";print "LINE=".__LINE__."\n";
} elsif ($compon eq 'Maps') {
$banner=" Select CMI (Custom Maps Item) to Import";print "LINE=".__LINE__."\n";
} else {
$banner=" Select CMB (Custom Menu Block) to Import";print "LINE=".__LINE__."\n";
}
my @comp=();print "LINE=".__LINE__."\n";
my $ll=0;my $l=0;print "LINE=".__LINE__."\n";
foreach my $loc (keys %main::fa_subs) {
$l=length $main::fa_subs{$loc}->[0];print "LINE=".__LINE__."\n";
$ll=$l if $l>$ll;print "LINE=".__LINE__."\n";
}
$ll+=3;print "LINE=".__LINE__."\n";
foreach my $loc (sort numerically keys %main::fa_subs) {
push @comp, sprintf "%-${ll}s %-s",
$main::fa_subs{$loc}->[0]," at Line $loc";print "LINE=".__LINE__."\n";
}
my %select_comp_to_import=(
Name => 'select_comp_to_import',
Item_1 => {
Text => ']C[',
Convey => \@comp,
Result => $select_location_to_insert_comp_sub,
},
Banner => $banner,
);print "LINE=".__LINE__."\n";
return \%select_comp_to_import,
}
};print "LINE=".__LINE__."\n";
my $select_component_file_sub=sub {
package select_component_file_sub;print "LINE=".__LINE__."\n";
use Term::ReadKey;print "LINE=".__LINE__."\n";
my $component="]!S[{select_component_dir}";print "LINE=".__LINE__."\n";
$component=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my $server="]!P[{im_from_remote}";print "LINE=".__LINE__."\n";
$server=~s/^["]Import from (.*)["]$/$1/;print "LINE=".__LINE__."\n";
my $user="]!S[{remote_fa_users}";print "LINE=".__LINE__."\n";
$user=~s/^["](.*)["]$/$1/;print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=$main::remote_host->cmd('/usr/local/bin/fullauto -V');print "LINE=".__LINE__."\n";
if ($stderr) {
$main::remote_host->close();print "LINE=".__LINE__."\n";
$stderr=~s/Connection cl/ Connection cl/s;print "LINE=".__LINE__."\n";
$stderr=~s/^\s*//s;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines,"\n\n ",$stderr,
" Press ANY KEY to return to the Admin Menu\n";print "LINE=".__LINE__."\n";
alarm 120;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode('cbreak');print "LINE=".__LINE__."\n";
# Turn off controls keys
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';print "LINE=".__LINE__."\n";
$key = ReadKey(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');print "LINE=".__LINE__."\n";
return '{admin}<';print "LINE=".__LINE__."\n";
}
my @comp=();print "LINE=".__LINE__."\n";
foreach my $line (split "\n", $stdout) {
next if -1==index $line, "$user/$component";print "LINE=".__LINE__."\n";
push @comp, $line;print "LINE=".__LINE__."\n";
}
my %select_user_comp_file=(
Name => 'select_user_comp_file',
Item_1 => {
Text => ']C[',
Convey => \@comp,
Result => $select_file_components_to_import_sub,
},
Banner => " Select $component File for $user",
);print "LINE=".__LINE__."\n";
return \%select_user_comp_file,
};print "LINE=".__LINE__."\n";
my $select_component_dir_sub=sub {
my %select_component_dir=(
Name => 'select_component_dir',
Item_1 => {
Text => ']C[',
Convey => ['Code','Conf','Host','Maps','Menu'],
Result => $select_component_file_sub,
},
Banner => ' Select Component Directory',
);print "LINE=".__LINE__."\n";
return \%select_component_dir,
};print "LINE=".__LINE__."\n";
my $login_to_remote=sub {
package login_to_remote;print "LINE=".__LINE__."\n";
use Term::ReadKey;print "LINE=".__LINE__."\n";
my $host_to_connect_to=']T[{im_from_remote}';print "LINE=".__LINE__."\n";
$host_to_connect_to=~s/^"Import from (.*)"$/$1/;print "LINE=".__LINE__."\n";
use if (!defined $Net::FullAuto::FA_Core::localhost), 'Net::FullAuto';print "LINE=".__LINE__."\n";
our $fa_code='Net::FullAuto::FA_Core.pm';print "LINE=".__LINE__."\n";
my @Hosts=();my $fa_host='';print "LINE=".__LINE__."\n";
unless (-1<index $Net::FullAuto::FA_Core::localhost,'=') {
$main::plan_menu_sub=1;print "LINE=".__LINE__."\n";
eval {
&Net::FullAuto::FA_Core::fa_login();print "LINE=".__LINE__."\n";
undef $main::plan_menu_sub;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::fa_set;print "LINE=".__LINE__."\n";
@Hosts=@{&Net::FullAuto::FA_Core::check_Hosts(
$Net::FullAuto::FA_Core::fa_host->[0])};print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::host_hash(\@Hosts);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
die $@ if $@;print "LINE=".__LINE__."\n";
}
my $error='';print "LINE=".__LINE__."\n";
my $host='';print "LINE=".__LINE__."\n";
foreach my $h (@Hosts) {
#print "H=",$h->{Label}," and HOST_TO_CONN=$host_to_connect_to\n";print "LINE=".__LINE__."\n";
if ($h->{Label} eq $host_to_connect_to) {
$host=$h;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
($main::remote_host,$error)=
&Net::FullAuto::FA_Core::connect_ssh($host_to_connect_to);print "LINE=".__LINE__."\n";
if ($error) {
$main::remote_host->close();print "LINE=".__LINE__."\n";
$error=~s/Connection cl/ Connection cl/s;print "LINE=".__LINE__."\n";
$error=~s/^\s*//s;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines,"\n\n ",$error,
" Press ANY KEY to return to the Admin Menu\n";print "LINE=".__LINE__."\n";
alarm 120;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode('cbreak');print "LINE=".__LINE__."\n";
# Turn off controls keys
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';print "LINE=".__LINE__."\n";
$key = ReadKey(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');print "LINE=".__LINE__."\n";
return '{admin}<';print "LINE=".__LINE__."\n";
}
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=$main::remote_host->cmd(
'/usr/local/bin/fullauto --users --quiet');print "LINE=".__LINE__."\n";
$stdout=~s/\s*$//s;print "LINE=".__LINE__."\n";
if ($stdout=~/^\s*$/s) {
my $message="\n\n".
" _ _ ___ _____ ___ _ \n".
" | \\| |/ _ \\_ _| __| (_)\n".
" | .` | (_) || | | _| _ \n".
" |_|\\_|\\___/ |_| |___| (_) \n".
"\n\n".
" *NO* users have yet been added to\n".
" the FullAuto installation on $host_to_connect_to.\n\n".
" To add a user, login directly to $host_to_connect_to\n".
" with the desired user login and run\n".
" fullauto with the --defaults argument\n".
" invoked from the command line.\n\n".
" Example: fa --defaults\n\n".
" Press ANY KEY to return to the Admin Menu\n";print "LINE=".__LINE__."\n";
#$main::remote_host->close();
print $Net::FullAuto::FA_Core::blanklines,$message;print "LINE=".__LINE__."\n";
alarm 120;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode('cbreak');print "LINE=".__LINE__."\n";
# Turn off controls keys
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';print "LINE=".__LINE__."\n";
$key = ReadKey(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');print "LINE=".__LINE__."\n";
return '{admin}<';print "LINE=".__LINE__."\n";
}
print "USERS=$stdout<== and STDERR=$stderr\n";print "LINE=".__LINE__."\n";
my @users=();print "LINE=".__LINE__."\n";
foreach my $user (split /\n/,$stdout) {
chomp $user;print "LINE=".__LINE__."\n";
push @users, $user;print "LINE=".__LINE__."\n";
}
if (-1<$#users) {
my %remote_fa_users=(
Name => 'remote_fa_users',
Item_1 => {
Text => ']C[',
Convey => \@users,
Result => $select_component_dir_sub,
},
Banner => ' Select User Account',
);print "LINE=".__LINE__."\n";
return \%remote_fa_users;print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::cleanup;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $im_from_remote=sub {
&Net::FullAuto::FA_Core::fa_set;print "LINE=".__LINE__."\n";
my $fa_host='';print "LINE=".__LINE__."\n";
my @Hosts=@{&Net::FullAuto::FA_Core::check_Hosts(
$Net::FullAuto::FA_Core::fa_host->[0])};print "LINE=".__LINE__."\n";
my %im_from_remote=(
Name => 'im_from_remote',
Item_1 => {
Text => 'Import from ]C[',
Convey => [ sort map { $_->{Label} } @Hosts ],
Result => $login_to_remote,
},
Banner => ' Select Remote Host to Import From',
);print "LINE=".__LINE__."\n";
return \%im_from_remote;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $im_ex_menu_sub=sub {
my %im_ex_menu=(
Name => 'im_ex_menu',
Item_1 => {
Text => 'IMPORT Component(s) from Remote Host',
Result => $im_from_remote,
},
Item_2 => {
Text => 'IMPORT Component(s) from Local Host',
Result => '',
},
Item_3 => {
Text => 'EXPORT Component(s) to File',
Result => '',
},
Banner => ' Select a FullAuto Component Operation to Perform',
);print "LINE=".__LINE__."\n";
return \%im_ex_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $set_menu_sub=sub {
my $default_modules=$_[0] || $main::get_default_modules->();print "LINE=".__LINE__."\n";
$default_modules->{'set'}||='none';print "LINE=".__LINE__."\n";
my $current_default_set=$default_modules->{'set'};print "LINE=".__LINE__."\n";
my $clearoption='';print "LINE=".__LINE__."\n";
my $sm_banner=<<FIN;print "LINE=".__LINE__."\n";
___ _ _ _ _ ___ _
| __| _| | | /_\\ _ _| |_ ___ / __| ___| |_ ___
| _| || | | |/ _ \\ || | _/ _ \\ \\__ \\/ -_) _(_-<
|_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/ |___/\\___|\\__/__/
FIN
$sm_banner.=" Please Select a Module Set Operation:\n\n";print "LINE=".__LINE__."\n";
if ($current_default_set eq 'none') {
$sm_banner.=" ** NO DEFAULT SET DEFINED **\n";print "LINE=".__LINE__."\n";
$clearoption="Keep as 'none'\n\n";print "LINE=".__LINE__."\n";
} else {
$sm_banner.=
" ** DEFAULT SET -> $current_default_set **\n";print "LINE=".__LINE__."\n";
$clearoption="Set to 'none'\n\n";print "LINE=".__LINE__."\n";
}
my %set_menu=(
Item_1 => {
Text => 'Select Default Module Set',
Result => $set_default_menu_sub->($default_modules),
},
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_sub->(),
},
Item_5 => {
Text => 'Manage Module Sets',
Result => $manage_modules_menu_sub->($default_modules),
},
Banner => $sm_banner
);print "LINE=".__LINE__."\n";
return \%set_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fa_welcome=<<END;print "LINE=".__LINE__."\n";
__ __)
(, ) | / /)
| /| / _ // _ ______ _ _/_ ___
|/ |/ _(/_(/_(__(_) // (__(/_ (__(_)
/ |
_ _ _ _____ _ _ _ _
| \\ | | ___| |_ | ___| _| | | / \\ _ _| |_ ___
| \\| |/ _ \\ __| o o | |_ | | | | | | / _ \\| | | | __/ _ \\
| |\\ | __/ || o o | _|| |_| | | |/ ___ \\ |_| | || (_) |
|_| \\_|\\___|\\__| |_| \\__,_|_|_/_/ \\_\\__,_|\\__\\___/
Copyright (C) 2000-2014 Brian M. Kelly Brian.Kelly\@fullautosoftware.net
END
my $fa_tutorial=<<END;print "LINE=".__LINE__."\n";
___ _ _ _ _
| __| _| | | /_\\ _ _| |_ ___
| _| || | | |/ _ \\ || | _/ _ \\
|_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/
_____ _ _ _
|_ _| _| |_ ___ _ _(_)__ _| |
| || || | _/ _ \\ '_| / _` | |
|_| \\_,_|\\__\\___/_| |_\\__,_|_|
END
my $fa_fullauto=<<END;print "LINE=".__LINE__."\n";
___ _ _ _ _
| __| _| | | /_\\ _ _| |_ ___
| _| || | | |/ _ \\ || | _/ _ \\
|_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/
END
my $fa_mini_welcome=" ( /_ /_ _ _ \n".
" |/|/(-(( ()//)(- ";print "LINE=".__LINE__."\n";
my $fa_new_user=<<END;print "LINE=".__LINE__."\n";
_ _ _ _
| \\| |_____ __ __ | | | |___ ___ _ _
| .` / -_) V V / | |_| (_-</ -_) '_|
|_|\\_\\___|\\_/\\_/ \\___//__/\\___|_|
END
my $fa_process_lifecycle=<<END;print "LINE=".__LINE__."\n";
___ _ _ __ _
| _ \\_ _ ___ __ ___ ______ | | (_)/ _|___ __ _ _ __| |___
| _/ '_/ _ \\/ _/ -_|_-<_-< | |__| | _/ -_) _| || / _| / -_)
|_| |_| \\___/\\__\\___/__/__/ |____|_|_| \\___\\__|\\_, \\__|_\\___|
|__/
In large organizations, development of any software or business
process takes place in stages, and the code travels through multiple
tiers or environments before it reaches "production" (or the "live"
environment that serves customers and end-users). Therefore, it is
likely that components developed in YOUR configuration "set" (which
includes the all important fa_code.pm file) will migrate to other
environments, other computers, even other users. You are likely to
eventually have MULTIPLE copies of a single process in different
stages of it's lifecycle - one in active development, one in testing,
and one in use for live processing.
END
my $fa_organization=<<END;print "LINE=".__LINE__."\n";
___ _ _ _
/ _ \\ _ _ __ _ __ _ _ _ (_)_____ _| |_(_)___ _ _
| (_) | '_/ _` / _` | ' \\| |_ / _` | _| / _ \\ ' \\
\\___/|_| \\__, \\__,_|_||_|_/__\\__,_|\\__|_\\___/_||_|
|___/
"A place for everything, everything in its place." - Benjamin Franklin
FullAuto organizes everything for you. A FullAuto working configuration
consists of five files which are listed below. You can read a summary
of each, or move on to creating ${username}'s own FullAuto setup!
END
my $fa_privacy=<<END;print "LINE=".__LINE__."\n";
___ _
| _ \\_ _(_)_ ____ _ __ _ _
| _/ '_| \\ V / _` / _| || |
|_| |_| |_|\\_/\\__,_\\__|\\_, |
|__/
FullAuto users OWN their setup. Nothing is shared
without an express intent to share it. That means
other FullAuto users cannot see or access your
automation projects. Sensitive projects can be
automated with TRUE privacy!
Additionally, no passwords are stored in clear
text. Even in memory, passwords are encrypted and
remain so until fed directly to an authenticating
process, safe even from core dumps!
END
my $fa_security=<<END;print "LINE=".__LINE__."\n";
___ _ _
/ __| ___ __ _ _ _ _(_) |_ _ _
\\__ \\/ -_) _| || | '_| | _| || |
|___/\\___\\__|\\_,_|_| |_|\\__|\\_, |
|__/
FullAuto is a SECURE Automation Framework. Security
is a necessary evil. Everybody needs it, but few want
to focus on it. It is inconvenient, and productivity
suffers from the burden it imposes. Yet, it is an
unavoidable requirement.
FullAuto was built from the ground up to be SECURE. User
authentication is therefore a REQUIREMENT. One FullAuto
installation, on one computer, can service any number
of users. FullAuto has built in utilities to setup and
manage user code, files, and configuration - securely!
END
my $fa_basics=<<END;print "LINE=".__LINE__."\n";
___ ___ _
/ __| ___ _ __ ___ | _ ) __ _ __(_)__ ___
\\__ \\/ _ \\ ' \\/ -_) | _ \\/ _` (_-< / _(_-<
|___/\\___/_|_|_\\___| |___/\\__,_/__/_\\__/__/
This wizard is interactive. You can go backwards and
forwards. Just press the LEFTARROW < key to navigate
backwards, the RIGHTARROW > key to go forward. Try it!
Notice at the bottom are commands you can type:
'help' to get the help or man (for "manual") screen
'admin' to get the admin menu
When you quit either help or admin, you automatically
return to this screen. To quit admin, type 'quit',
and to quit the help page, type 'q'. Try it!
END
my $fa_no_web=<<END;print "LINE=".__LINE__."\n";
_ _ __ __ _ ___ ___ _
| \\| |___ \\ \\ / /__| |__ | _ \\__ _ __ _ __|__ \\ |
| .` / _ \\ \\ \\/\\/ / -_) '_ \\ | _/ _` / _` / -_)/_/_|
|_|\\_\\___/ \\_/\\_/\\___|_.__/ |_| \\__,_\\__, \\___(_)(_)
|___/
YES! FullAuto is Automation Software. Ever see a furnace room
with marble tile? Or a fully enclosed car trunk with rich soft
leather? We decorate what we SEE and spend lots of time around.
Things we rarely access, we keep simple and utilitarian.
__ _____ __ __ __ __ _____
(_ |_ | _|_ |_ / \\|__)/ _ |_ |
FullAuto is __)|__ | | | \\__/| \\ \\__)|__ | software.
Hence the name Full - Auto (as in 'full' or 'complete' AUTOMATION).
You tell it what to do, you turn it on - and you MOVE ON to more
enjoyable or urgent activities!
END
my $fa_intro=<<END;print "LINE=".__LINE__."\n";
___ _ _ _ _
|_ _|_ _| |_ _ _ ___ __| |_ _ __| |_(_)___ _ _
| || ' \\ _| '_/ _ \\/ _` | || / _| _| / _ \\ ' \\
|___|_||_\\__|_| \\___/\\__,_|\\_,_\\__|\\__|_\\___/_||_|
FullAuto is an Automation Framework. With this program,
nearly *ANY* computer process can be automated! But first
a person has to tell it what to do. This wizard will help
do that. This command environment wizard is an important
innovation of FullAuto. Everything you are experiencing
now, can be used used to make *YOUR* automation projects
easier to create and maintain. Your project can and SHOULD
tell a story just like this one.
You can revisit this story anytime - at the command line:
fa --new-user
END
my $fa_continue_setup=<<END;print "LINE=".__LINE__."\n";
END
my $fa_fa_code_banner=<<END;print "LINE=".__LINE__."\n";
__ _
_/ _)__ _ __ ___ __| |___ _ __ _ __
( _/ _` | / _/ _ \\/ _` / -_)_| '_ \\ ' \\
|_| \\__,_|====\\__\\___/\\__,_\\___(_) .__/_|_|_|
|_|
This is the single most important file in FullAuto. In
this file, 90% of all automation development work takes
place. This is the FullAuto Custom Code file. This file
is where you give FullAuto its "marching orders".
You can always access this file - and all your user
files from the the 'edit' menu:
fa --edit
You can also use a shortcut to access it directly: fa -ec
END
my $fa_fa_conf_banner=<<END;print "LINE=".__LINE__."\n";
__ __
_/ _)__ _ __ ___ _ _ _/ _) _ __ _ __
( _/ _` | / _/ _ \\ ' \\( _/_| '_ \\ ' \\
|_| \\__,_|====\\__\\___/_||_||_| (_) .__/_|_|_|
|_|
This is the user's FullAuto Configuration File. This file
contains personal preferences such as choice of editor.
(Currently this file does not have much use beyond the
editor setting. But as FullAuto grows and matures, it
is certain that more settings will be developed).
END
my $fa_fa_host_banner=<<END;print "LINE=".__LINE__."\n";
__ _ _
_/ _)__ _ | |_ ___ __| |_ _ __ _ __
( _/ _` | | ' \\/ _ (_-< _|_| '_ \\ ' \\
|_| \\__,_|====|_||_\\___/__/\\__(_) .__/_|_|_|
|_|
This is the user's FullAuto Host File. The host file
is used to store connection and authentication settings
for individual computers and devices. This enables
processes to be developed in different environments,
but sharing the same custom code (in the fa_code.pm
file).
FullAuto was designed to make automation code as
portable as possible. This file makes that goal easy!
This file can be accessed with the shortcut: fa -eh
END
my $fa_fa_maps_banner=<<END;print "LINE=".__LINE__."\n";
__
_/ _)__ _ _ __ __ _ _ __ ___ _ __ _ __
( _/ _` | | ' \\/ _` | '_ (_-<_| '_ \\ ' \\
|_| \\__,_|====|_|_|_\\__,_| .__/__(_) .__/_|_|_|
|_| |_|
This is the FullAuto Maps File. Often there is a need
for intermediate or proxy connections to gain access
to other computers in other networks. This file is
intended to store mappings of chained connections.
Those mappings can then be accessed via a label name
in the fa_code.pm file. This will make automation
code smaller and easier to read, since FullAuto will
handle all these chained connections seamlessly.
(This feature is not yet fully implemented.)
END
my $fa_fa_menu_banner=<<END;print "LINE=".__LINE__."\n";
__
_/ _|__ _ _ __ ___ _ _ _ _ _ __ _ __
( _/ _` | | ' \\/ -_) ' \\ || |_| '_ \\ ' \\
|_| \\__,_|====|_|_|_\\___|_||_\\_,_(_) .__/_|_|_|
|_|
This is the FullAuto Menu File. Net::FullAuto has
a sister module also written by Brian Kelly called
Term::Menus. Any process can contain Term::Menus
menus, but this file solves the problem of menu-zing
the process itself. When FullAuto is started without
a specifc --code argument (which specifies a single
process), a menu showing all available processes is
displayed.
This file can be accessed with the shortcut: fa -em
END
my $fa_batter_up=<<END;print "LINE=".__LINE__."\n";
___ _ _ _ _ ___ _
| _ ) __ _| |_| |_ ___ _ _ | | | | _ \\ |
| _ \\/ _` | _| _/ -_) '_| | |_| | _/_|
|___/\\__,_|\\__|\\__\\___|_| \\___/|_| (_)
In baseball, there are many players on a team, but
only ONE player at a time can pick up a bat and step
up to the plate. Similarly, only one file "SET" can
be active in FullAuto at any one time. As mentioned
earlier, they are the five files listed two screens
ago. (You can navigate backwards and review them at
any time.) As mentioned in the last screen, there
may be multiple copies of any or all of the five files.
How does FullAuto know which five to use?
END
my $fa_fa_defaults2=<<END;print "LINE=".__LINE__."\n";
_ _ _ __ __ ___ __ _ _ _
| \\| |___| |_ | \\/ |_ _ | \\ ___ / _|__ _ _ _| | |_ __| |
| .` / _ \\ _| | |\\/| | || | | |) / -_) _/ _` | || | | _(_-<_|
|_|\\_\\___/\\__| |_| |_|\\_, | |___/\\___|_| \\__,_|\\_,_|_|\\__/__(_)
|__/
The --defaults utility also (conveniently) displays what your current
END
my $fa_set_defaults=<<END;print "LINE=".__LINE__."\n";
___ _ _ ___ _ _
/ __| |_ __ _ _ _| |_ | \\ ___(_)_ _ __ _| |
\\__ \\ _/ _` | '_| _| | |) / _ \\ | ' \\/ _` |_|
|___/\\__\\__,_|_| \\__| |___/\\___/_|_||_\\__, (_)
|___/
It's time to do you FIRST FullAuto activity! It's time to
select your very first "set" of the five required files. For
your first file set, you will simply be choosing the templates
supplied with FullAuto - and there are only one of each.
It's REALLY EASY - the next screen is the actual utility
you will always use to choose and change your defaults.
Choose the first option and follow the instructions.
When finished you can choose to commit the changes - or not.
If not, you will get this "new user wizard" the next time you
run FullAuto. (Which is great if you're just exploring!)
END
my $fa_fa_defaults_sub=sub {
$fa_fa_defaults2.=
' "defaults" are. Below are the actual defaults currently set. ';print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $default_modules=$main::get_default_modules->();print "LINE=".__LINE__."\n";
if (-1<index $default_modules->{'fa_code'},'/Distro/') {
$fa_fa_defaults2.="Since $username\n".
" is a new user, you see the word 'Distro' in the five ".
"file locations below.\n\n";print "LINE=".__LINE__."\n";
} else {
$fa_fa_defaults2.="You can see\n".
" the full paths to these files anytime by using the ".
"command: fa -V\n\n";print "LINE=".__LINE__."\n";
}
my $banner=$fa_fa_defaults2;print "LINE=".__LINE__."\n";
$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\n";print "LINE=".__LINE__."\n";
return $banner;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fa_fa_defaults=<<END;print "LINE=".__LINE__."\n";
___ _ _ _ _ ___ __ _ _
| __| _| | | /_\\ _ _| |_ ___ | \\ ___ / _|__ _ _ _| | |_ ___
| _| || | | |/ _ \\ || | _/ _ \\ | |) / -_) _/ _` | || | | _(_-<
|_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/ |___/\\___|_| \\__,_|\\_,_|_|\\__/__/
Most of the time you'll be working with the same five file set. It would
get VERY tiring to have to choose these files manually every time you
went to work with FullAuto. Not to mention trying to keep the same five
files bundled together accurately! (Which is critical for proper
functioning of your automation code.)
For that reason, one of the most important features of FullAuto is the
--defaults utility - which is built into FullAuto itself. The defaults
utility is a menu-ized wizard just like this presentation you are now
enjoying (hopefully!)
END
my $fa_fa_code=sub {
my %fa_fa_code=(
Name => 'fa_fa_code',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_code_banner,
);print "LINE=".__LINE__."\n";
return \%fa_fa_code;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fa_fa_conf=sub {
my %fa_fa_conf=(
Name => 'fa_fa_conf',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_conf_banner,
);print "LINE=".__LINE__."\n";
return \%fa_fa_conf;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fa_fa_host=sub {
my %fa_fa_host=(
Name => 'fa_fa_host',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_host_banner,
);print "LINE=".__LINE__."\n";
return \%fa_fa_host;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fa_fa_maps=sub {
my %fa_fa_maps=(
Name => 'fa_fa_maps',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_maps_banner,
);print "LINE=".__LINE__."\n";
return \%fa_fa_maps;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $fa_fa_menu=sub {
my %fa_fa_menu=(
Name => 'fa_fa_menu',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_menu_banner,
);print "LINE=".__LINE__."\n";
return \%fa_fa_menu;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user10=sub{
$main::new_user_flag=1;print "LINE=".__LINE__."\n";
my %setup_new_user10=(
Name => 'setup_new_user10',
Result => $viewdefaults_sub,
Banner => $fa_set_defaults,
);print "LINE=".__LINE__."\n";
return \%setup_new_user10;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user9=sub{
my %setup_new_user9=(
Name => 'setup_new_user9',
Result => $setup_new_user10,
Banner => $fa_fa_defaults_sub,
);print "LINE=".__LINE__."\n";
return \%setup_new_user9;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user8=sub{
my %setup_new_user8=(
Name => 'setup_new_user8',
Result => $setup_new_user9,
Banner => $fa_fa_defaults,
);print "LINE=".__LINE__."\n";
return \%setup_new_user8;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user7=sub{
my %setup_new_user7=(
Name => 'setup_new_user7',
Result => $setup_new_user8,
Banner => $fa_batter_up,
);print "LINE=".__LINE__."\n";
return \%setup_new_user7;
};print "LINE=".__LINE__."\n";
my $setup_new_user6=sub{
my %setup_new_user6=(
Name => 'setup_new_user6',
Result => $setup_new_user7,
Banner => $fa_process_lifecycle,
);print "LINE=".__LINE__."\n";
return \%setup_new_user6;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user5=sub{
my %setup_new_user5=(
Name => 'setup_new_user5',
Item_1 => {
Text => 'fa_code.pm',
Result => $fa_fa_code,
},
Item_2 => {
Text => 'fa_conf.pm',
Result => $fa_fa_conf,
},
Item_3 => {
Text => 'fa_host.pm',
Result => $fa_fa_host,
},
Item_4 => {
Text => 'fa_maps.pm',
Result => $fa_fa_maps,
},
Item_5 => {
Text => 'fa_menu.pm',
Result => $fa_fa_menu,
},
Item_6 => {
Text => 'Continue GETTING STARTED with FullAuto!',
Result => $setup_new_user6,
},
Banner => $fa_organization,
);print "LINE=".__LINE__."\n";
return \%setup_new_user5;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user4=sub{
my %setup_new_user4=(
Name => 'setup_new_user4',
Result => $setup_new_user5,
Banner => $fa_privacy,
);print "LINE=".__LINE__."\n";
return \%setup_new_user4;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user3=sub{
my %setup_new_user3=(
Name => 'setup_new_user3',
Result => $setup_new_user4,
Banner => $fa_security,
);print "LINE=".__LINE__."\n";
return \%setup_new_user3;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user2=sub {
my %setup_new_user2=(
Name => 'setup_new_user2',
Result => $setup_new_user3,
Banner => $fa_basics,
);print "LINE=".__LINE__."\n";
return \%setup_new_user2;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user_a=sub {
my %setup_new_user_a=(
Name => 'setup_new_user_a',
Result => $setup_new_user2,
Banner => $fa_intro,
);print "LINE=".__LINE__."\n";
return \%setup_new_user_a;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $setup_new_user=sub {
my %setup_new_user=(
Name => 'setup_new_user',
Result => $setup_new_user_a,
Banner => $fa_no_web,
);print "LINE=".__LINE__."\n";
return \%setup_new_user;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
sub new_user_experience {
print $fa_welcome;print "LINE=".__LINE__."\n";
sleep 3;print "LINE=".__LINE__."\n";
my $new_user=$_[0]||'';print "LINE=".__LINE__."\n";
my $welcome=$_[1]||'';print "LINE=".__LINE__."\n";
my $newuser=$_[2]||'';print "LINE=".__LINE__."\n";
my $banner='';my $text=[];print "LINE=".__LINE__."\n";
my %welcome_menu=();print "LINE=".__LINE__."\n";
if ($new_user or $newuser) {
$text=[
"Setup User $username (Advanced Users)",
"Continue with Login (No setup for $username) &\n ".
" Do Not Show this Screen Again",
"Continue with Login (No setup for $username)" ],
$banner="$fa_fullauto\n $fa_mini_welcome $username!\n"
."\n It appears "
."that $username is new to FullAuto,"
."\n for there is no FullAuto "
."Setup for this user.";print "LINE=".__LINE__."\n";
%welcome_menu=(
Label => 'welcome_menu',
Item_1 => {
Text => "Getting Started (QUICKLY) with FullAuto!\n".
" ".
"HIGHLY Recommended for Beginners!\n\n",
Default => "*",
Result => $setup_new_user,
},
Item_2 => {
Text => ']C[',
Convey => $text,
},
Banner => $banner,
);print "LINE=".__LINE__."\n";
} elsif ($welcome) {
$text=[ "Admin Menu",
"User Accounts" ];print "LINE=".__LINE__."\n";
$banner=$fa_tutorial
." Please select a subject to explore:";print "LINE=".__LINE__."\n";
%welcome_menu=(
Label => 'welcome_menu',
Item_1 => {
Text => ']C[',
Convey => $text,
},
Banner => $banner,
);print "LINE=".__LINE__."\n";
}
my $choice=Menu(\%welcome_menu)||'';print "LINE=".__LINE__."\n";
if (-1<index $choice,'Create Account') {
print "YEP, CREATE ACCOUNT\n";<STDIN>;print "LINE=".__LINE__."\n";
}
}
sub numerically { $a <=> $b }
sub fa_login
{
if (defined $_[0] && $_[0]=~/^\d+$/) {
$timeout=$_[0];print "LINE=".__LINE__."\n";
} else {
my $time_out='$' . (caller)[0] . '::timeout';print "LINE=".__LINE__."\n";
$time_out= eval $time_out;print "LINE=".__LINE__."\n";
$time_out||=30;print "LINE=".__LINE__."\n";
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;print "LINE=".__LINE__."\n";
} else { $timeout=$time_out }
} $test=0;$prod=0;print "LINE=".__LINE__."\n";
###################################
# The following are being set if
# found defined in Term::Menus
my $log_='$' . (caller)[0] . '::log';print "LINE=".__LINE__."\n";
$log_= eval $log_;print "LINE=".__LINE__."\n";
$log_=0 if $@ || !$log_;print "LINE=".__LINE__."\n";
my $tosspass_='$' . (caller)[0] . '::tosspass';print "LINE=".__LINE__."\n";
$tosspass_= eval $tosspass_;print "LINE=".__LINE__."\n";
$tosspass_=0 if $@ || !$tosspass_;print "LINE=".__LINE__."\n";
## end Term::Menus defs ###########
my $fhtimeout='X';print "LINE=".__LINE__."\n";
my $fatimeout=$timeout;print "LINE=".__LINE__."\n";
my $tst='$' . (caller)[0] . '::test';print "LINE=".__LINE__."\n";
$tst=eval $tst;print "LINE=".__LINE__."\n";
$test=$tst if !$@ || $tst=~/^[1-9]+/;print "LINE=".__LINE__."\n";
my $_connect='connect_ssh_telnet';print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'Local'}) {
my $loc=$Hosts{"__Master_${$}__"}{'Local'};print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
} elsif ($loc eq 'connect_ssh') {
$_connect=$loc;print "LINE=".__LINE__."\n";
@RCM_Link=('ssh');print "LINE=".__LINE__."\n";
} elsif ($loc eq 'connect_telnet') {
$_connect=$loc;print "LINE=".__LINE__."\n";
@RCM_Link=('telnet');print "LINE=".__LINE__."\n";
} elsif ($loc eq 'connect_ssh_telnet') {
$_connect=$loc;print "LINE=".__LINE__."\n";
@RCM_Link=('ssh','telnet');print "LINE=".__LINE__."\n";
} else {
$_connect=$loc;print "LINE=".__LINE__."\n";
@RCM_Link=('telnet','ssh');print "LINE=".__LINE__."\n";
}
} else {
@RCM_Link=('ssh','telnet');print "LINE=".__LINE__."\n";
$Hosts{"__Master_${$}__"}{'Local'}=$_connect;print "LINE=".__LINE__."\n";
}
$email_defaults='%' . (caller)[0] . '::email_defaults';print "LINE=".__LINE__."\n";
%email_defaults=eval $email_defaults;print "LINE=".__LINE__."\n";
if ($@) {
$email_defaults=0;print "LINE=".__LINE__."\n";
%email_defaults=();print "LINE=".__LINE__."\n";
} else { $email_defaults=1 }
my $email_addresses='%' . (caller)[0] . '::email_addresses';print "LINE=".__LINE__."\n";
%email_addresses=eval $email_addresses;print "LINE=".__LINE__."\n";
%email_addresses=() if $@;print "LINE=".__LINE__."\n";
my $test_caller=(caller)[0];print "LINE=".__LINE__."\n";
$custom_code_module_file='$' . (caller)[0] . '::fa_code';print "LINE=".__LINE__."\n";
$custom_code_module_file=eval $custom_code_module_file;print "LINE=".__LINE__."\n";
if ($@) {
my $die="Cannot Locate the \"FullAuto Custom Code\" "
."perl module (.pm) file\n < original "
."default name 'fa_code.pm' >\n\n $@";print "LINE=".__LINE__."\n";
&handle_error($die,'-3');print "LINE=".__LINE__."\n";
}
my $man=0;my $help=0;my $userflag=0;my $passerror=0;print "LINE=".__LINE__."\n";
my $test_arg=0;my $oldcipher='';my $password_from='user_input';print "LINE=".__LINE__."\n";
my @holdARGV=@ARGV;@menu_args=();my $username_from='';print "LINE=".__LINE__."\n";
my $cust_subnam_in_fa_code_module_file;my $sem='';print "LINE=".__LINE__."\n";
my $sshport='';print "LINE=".__LINE__."\n";
Getopt::Long::Configure ("bundling");print "LINE=".__LINE__."\n";
&GetOptions(
'admin' => \$admin,
'menu' => \$menu,
'welcome' => \$welcome,
'new_user' => \$newuser,
'newuser' => \$newuser,
'new-user' => \$newuser,
'tutorial' => \$tutorial,
'about' => \$version,
'authorize_connect' => \$authorize_connect,
'cache_root=s' => \$cache_root,
'cache_key=s' => \$cache_key,
'debug' => \$debug,
'scrub' => \$scrub,
'help|?' => \$help,
'h|?' => \$help,
'i=s' => \$identityfile,
'identity_file=s' => \$identityfile,
'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,
'cat:s' => \$cat,
'edit:s' => \$edit,
'e:s' => \$edit,
'users' => \$users,
'v' => \$version,
'version' => \$version,
'V' => \$VERSION,
) or pod2usage(2);print "LINE=".__LINE__."\n";
pod2usage(1) if $help;print "LINE=".__LINE__."\n";
pod2usage(-exitstatus => 0, -verbose => 2) if $man;print "LINE=".__LINE__."\n";
@ARGV=@holdARGV;undef @holdARGV;print "LINE=".__LINE__."\n";
$random='__random__' if $random;print "LINE=".__LINE__."\n";
if (defined $log) { $log=1 }
$log=$log_ if !$log;print "LINE=".__LINE__."\n";
$tosspass=$tosspass_ if !$tosspass;print "LINE=".__LINE__."\n";
if ($test_arg) {
$prod=0;$test=1;print "LINE=".__LINE__."\n";
} elsif ($prod) {
$test=0;print "LINE=".__LINE__."\n";
}
my $save_main_pass=0;my $track=0;print "LINE=".__LINE__."\n";
if (defined $passwrd) {
if ($passwrd) {
$passwd[0]=$passwrd;print "LINE=".__LINE__."\n";
$password_from='cmd_line_arg';print "LINE=".__LINE__."\n";
} else {
$save_main_pass=1;print "LINE=".__LINE__."\n";
} undef $passwrd;print "LINE=".__LINE__."\n";
}
if (defined $usrname) {
$username=$usrname;print "LINE=".__LINE__."\n";
$username_from='cmd_line_arg';print "LINE=".__LINE__."\n";
$userflag=1;print "LINE=".__LINE__."\n";
} else {
$username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
}
if (defined $identityfile) {
$identity_file=$identityfile;print "LINE=".__LINE__."\n";
} elsif (exists $Hosts{'localhost'}{'identity_file'}) {
$identity_file=$Hosts{'localhost'}{'identity_file'};print "LINE=".__LINE__."\n";
}
if ($identity_file && !(-r $identity_file)) {
my $login_Mast_error="SSH identity_file $identity_file cannot be read.";print "LINE=".__LINE__."\n";
my $die="\n FATAL ERROR! - The Host "
."$Net::FullAuto::FA_Core::local_hostname Returned"
."\n the Following Unrecoverable Error Condition\,"
."\n Rejecting the Login Attempt of the ID"
."\n -> $username :\n\n "
."$login_Mast_error\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
if (-1<$#_ && $_[0] && $_[0]!~/^\d+$/) {
if ($#_ && $#_%2!=0) {
my $key='';my $margs=0;print "LINE=".__LINE__."\n";
foreach my $arg (@_) {
if (!$key) {
$key=$arg;next;print "LINE=".__LINE__."\n";
} else {
if ($key eq 'local-login-id') {
$username=$arg;print "LINE=".__LINE__."\n";
} elsif ($key eq 'login') {
$username=$arg;print "LINE=".__LINE__."\n";
} elsif ($key eq 'password') {
$password_from='fa_login_arg';print "LINE=".__LINE__."\n";
$arg=~/^(.*)$/;print "LINE=".__LINE__."\n";
$passwd[0]=$1;print "LINE=".__LINE__."\n";
} elsif ($key eq 'sub_arg' ||
$key eq 'sub-arg') {
@menu_args=() if !$margs;print "LINE=".__LINE__."\n";
$margs=1;print "LINE=".__LINE__."\n";
push @menu_args, $arg;print "LINE=".__LINE__."\n";
} elsif ($key ne 'test' || $prod==0) {
${$key}=$arg;print "LINE=".__LINE__."\n";
} $key='';print "LINE=".__LINE__."\n";
}
}
} else {
&handle_error("Wrong Number of Arguments to &fa_login");print "LINE=".__LINE__."\n";
}
} elsif (!$prod && defined $_[1] &&
(!defined $_[0] || !$_[0] || $_[0]=~/^\d+$/)) {
$test=$_[1];print "LINE=".__LINE__."\n";
}
#$passwd[1]=$passwd[0];print "LINE=".__LINE__."\n";
#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;print "LINE=".__LINE__."\n";
}
$batch=']Batch[';print "LINE=".__LINE__."\n";
$unattended=']Unattended[';print "LINE=".__LINE__."\n";
$fullauto=']FullAuto[';print "LINE=".__LINE__."\n";
$cron=']Cron[';print "LINE=".__LINE__."\n";
}
if (($Term::Menus::new_user_flag or $welcome or $newuser) &&
!$default) {
$Net::FullAuto::FA_Core::skip_host_hash=1;print "LINE=".__LINE__."\n";
&new_user_experience($Term::Menus::new_user_flag,
$welcome,$newuser);print "LINE=".__LINE__."\n";
}
my $cache='';print "LINE=".__LINE__."\n";
foreach my $hl ('cache','localhost') {
if (exists $Hosts{$hl} && exists $Hosts{$hl}->{Cache}
&& ((exists $Hosts{$hl}->{Start_Cache}
&& $Hosts{$hl}->{Start_Cache})
|| $cache_root || $cache_key)) {
if (ref $Hosts{$hl}->{Cache} ne 'CODE') {
my $die="\n FATAL ERROR - The 'Cache' item/element "
."for\n -> \"$hl"
."\"\n called from fa_login() "
." is not a valid reference\n"
." to an anonymous subroutine:\n\n"
." Example: Cache => sub { ... },\n\n"
." in the Block labeled \"$hl\"\n"
." -> $Net::FullAuto::FA_Core::fa_host .\n\n";print "LINE=".__LINE__."\n";
print $die if (!$cron && $debug) && !$quiet;print "LINE=".__LINE__."\n";
exit 1;
} elsif (defined $cache_root && $cache_root && -d $cache_root) {
$cache=cache('cache',$cache_root);print "LINE=".__LINE__."\n";
if ($cache->chi_root_class) {
if (defined $cache_key && $cache_key) {
$cache->{'key'}=$cache_key;print "LINE=".__LINE__."\n";
}
unless (exists $cache->{'key'} && $cache->{'key'}) {
my $die="\n FATAL ERROR - No key defined for cache.\n\n"
." at ".__PACKAGE__." Line: ".__LINE__."\n\n";print "LINE=".__LINE__."\n";
print $die if (!$cron && $debug) && !$quiet;print "LINE=".__LINE__."\n";
exit 1;print "LINE=".__LINE__."\n";
}
} else {
my $die="\n FATAL ERROR - No cache root dir defined for cache.\n\n"
." at ".__PACKAGE__." Line: ".__LINE__."\n\n";print "LINE=".__LINE__."\n";
print $die if (!$cron && $debug) && !$quiet;print "LINE=".__LINE__."\n";
exit 1;print "LINE=".__LINE__."\n";
}
} elsif (defined $cache_key && $cache_key) {
$cache=cache('cache');print "LINE=".__LINE__."\n";
unless ($cache->chi_root_class) {
my $die="\n FATAL ERROR - No cache root dir defined for cache.\n\n"
." at ".__PACKAGE__." Line: ".__LINE__."\n\n";print "LINE=".__LINE__."\n";
print $die if (!$cron && $debug) && !$quiet;print "LINE=".__LINE__."\n";
exit 1;print "LINE=".__LINE__."\n";
}
$cache->{'key'}=$cache_key;print "LINE=".__LINE__."\n";
} last if $cache;print "LINE=".__LINE__."\n";
}
}
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n Starting $progname . . .\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n Starting $progname . . .\n"])
if $cache;print "LINE=".__LINE__."\n";
}
sleep 2 if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
my $su_scrub='';my $login_Mast_error='';my $id='';my $use='';print "LINE=".__LINE__."\n";
my $hostlabel='';my $mainuser='';my $retrys='';print "LINE=".__LINE__."\n";
my $su_err='';my $su_id='';my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
my $hostname='';my $fullhostname='';my $passline='';print "LINE=".__LINE__."\n";
my $host=''; my $cmd_type='';my $cmd_pid='';my $login_id;print "LINE=".__LINE__."\n";
my $password='';print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'HostName'} &&
-1<index $Hosts{"__Master_${$}__"}{'HostName'},'.') {
$hostname=substr($Hosts{"__Master_${$}__"}{'HostName'},0
,(index $Hosts{"__Master_${$}__"}{'HostName'},'.'))||'';print "LINE=".__LINE__."\n";
$fullhostname=$Hosts{"__Master_${$}__"}{'HostName'};print "LINE=".__LINE__."\n";
} else {
$fullhostname=$hostname=$Hosts{"__Master_${$}__"}{'HostName'}||'';print "LINE=".__LINE__."\n";
}
my $ip=inet_ntoa((gethostbyname($hostname))[4])||'';print "LINE=".__LINE__."\n";
my $suroot='';print "LINE=".__LINE__."\n";
foreach my $host (keys %same_host_as_Master) {
next if $host eq "__Master_${$}__";print "LINE=".__LINE__."\n";
if (exists $Hosts{$host}{'LoginID'} &&
($Hosts{$host}{'LoginID'} eq $username)) {
$su_id='' if !$mainuser;print "LINE=".__LINE__."\n";
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};print "LINE=".__LINE__."\n";
$mainuser=1;print "LINE=".__LINE__."\n";
if (exists $Hosts{$host}{'SU_ID'}) {
$su_id=$Hosts{$host}{'SU_ID'};print "LINE=".__LINE__."\n";
$hostlabel=$host;print "LINE=".__LINE__."\n";
$suroot=(getgrnam('suroot'))[3];print "LINE=".__LINE__."\n";
last if $su_id eq 'root';print "LINE=".__LINE__."\n";
} next
} elsif (!$mainuser && exists $Hosts{$host}{'SU_ID'}) {
$su_id=$Hosts{$host}{'SU_ID'};print "LINE=".__LINE__."\n";
$suroot=(getgrnam('suroot'))[3];print "LINE=".__LINE__."\n";
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};print "LINE=".__LINE__."\n";
$hostlabel=$host;print "LINE=".__LINE__."\n";
} else {
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};print "LINE=".__LINE__."\n";
} $hostlabel=$host if !$hostlabel;print "LINE=".__LINE__."\n";
} $hostlabel="__Master_${$}__" if !$hostlabel;print "LINE=".__LINE__."\n";
$master_hostlabel=$hostlabel;$hostlabel="__Master_${$}__";print "LINE=".__LINE__."\n";
$Hosts{$hostlabel}{'Uname'}=$^O;print "LINE=".__LINE__."\n";
if ($cltimeout ne 'X') {
$fatimeout=$fhtimeout=$cltimeout;print "LINE=".__LINE__."\n";
} elsif ($fhtimeout ne 'X') {
$fatimeout=$fhtimeout;print "LINE=".__LINE__."\n";
} $retrys=0;print "LINE=".__LINE__."\n";
#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 '/';print "LINE=".__LINE__."\n";
# $Hosts{"__Master_${$}__"}{'FA_Secure'}=
# $Hosts{$key}{'FA_Secure'};print "LINE=".__LINE__."\n";
# last
# }
#}
#my $FA_Core_path='';print "LINE=".__LINE__."\n";
#foreach my $key (keys %INC) {
# if (-1<index $key,'FA_Core.pm') {
# $FA_Core_path=substr($INC{$key},0,(rindex $INC{$key},'/')+1);print "LINE=".__LINE__."\n";
# last;print "LINE=".__LINE__."\n";
# }
#} $Hosts{"__Master_${$}__"}{'FA_Core'}=$FA_Core_path;print "LINE=".__LINE__."\n";
#if (!exists $Hosts{"__Master_${$}__"}{'FA_Secure'}) {
# unless (-d '/var/db/Berkeley/FullAuto') {
# my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
# my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
# unless (-d '/var/db') {
# my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
# $m.'/var/db';print "LINE=".__LINE__."\n";
# my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
# ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
# &handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
# }
# unless (-d '/var/db/Berkeley') {
# my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
# $m.'/var/db/Berkeley';print "LINE=".__LINE__."\n";
# my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
# ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
# &handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
# }
# unless (-d '/var/db/Berkeley/FullAuto') {
# my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
# $m.'/var/db/Berkeley/FullAuto';print "LINE=".__LINE__."\n";
# my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
# ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
# &handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
# }
# }
# if (!(-d '/var/db/Berkeley/FullAuto' && -w _)) {
# &handle_error("Cannot Write to Berkeley FullAuto Directory :".
# "\n\n ".
# '/var/db/Berkeley/FullAuto');print "LINE=".__LINE__."\n";
# }
# $Hosts{"__Master_${$}__"}{'FA_Secure'}=
# '/var/db/Berkeley/FullAuto/';print "LINE=".__LINE__."\n";
#} elsif (!(-d $Hosts{"__Master_${$}__"}{'FA_Secure'} && -w _)) {
# handle_error("Cannot Write to Berkeley FullAuto Directory :".
# "\n\n ".
# $Hosts{"__Master_${$}__"}{'FA_Secure'});print "LINE=".__LINE__."\n";
#} else {
# $Hosts{"__Master_${$}__"}{'FA_Secure'}.='/' if
# substr($Hosts{"__Master_${$}__"}{'FA_Secure'},-1) ne '/';print "LINE=".__LINE__."\n";
#}
if ($updatepw) {
my $uid=$username;print "LINE=".__LINE__."\n";
while (1) {
if ($^O ne 'cygwin') {
print $blanklines;print "LINE=".__LINE__."\n";
} else {
print "$blanklines\n";print "LINE=".__LINE__."\n";
}
if ($login_Mast_error) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n ERROR MESSAGE (4) -> $login_Mast_error";print "LINE=".__LINE__."\n";
} else {
print "\n ERROR MESSAGE -> $login_Mast_error";print "LINE=".__LINE__."\n";
}
}
if ($test && !$prod) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n Running in TEST (1) mode\n";print "LINE=".__LINE__."\n";
} else {
print "\n Running in TEST mode\n";print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
print "\n Running in PRODUCTION (1) mode\n"
} else {
print "\n Running in PRODUCTION mode\n"
}
}
my $usrname_timeout=350;print "LINE=".__LINE__."\n";
my $usrname='';print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($usrname_timeout);print "LINE=".__LINE__."\n";
&acquire_fa_lock(1234);print "LINE=".__LINE__."\n";
my $ikey='';print "LINE=".__LINE__."\n";
print "\n";print "LINE=".__LINE__."\n";
($usrname,$ikey)=rawInput(" $hostname Login <$uid> : ");print "LINE=".__LINE__."\n";
&release_fa_lock(1234);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@ eq "alarm\n") {
print "\n\n";print "LINE=".__LINE__."\n";
&handle_error(
"Time Allowed for Username Input has Expired.",
'__cleanup__');print "LINE=".__LINE__."\n";
}
chomp $usrname;print "LINE=".__LINE__."\n";
$usrname=~s/^\s*//s;print "LINE=".__LINE__."\n";
$usrname=~s/\s*$//s;print "LINE=".__LINE__."\n";
next if $usrname=~/^\d/ || !$usrname && !$uid;print "LINE=".__LINE__."\n";
$username= ($usrname) ? $usrname : $uid;print "LINE=".__LINE__."\n";
$username_from='user_input';print "LINE=".__LINE__."\n";
$userflag=1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
while (1) {
print "\n Enter Old Password: ";print "LINE=".__LINE__."\n";
ReadMode 2;print "LINE=".__LINE__."\n";
&release_fa_lock(1234);print "LINE=".__LINE__."\n";
my $pas=<STDIN>;print "LINE=".__LINE__."\n";
$pas=~/^(.*)$/;print "LINE=".__LINE__."\n";
$passwd[0]=$1;print "LINE=".__LINE__."\n";
&acquire_fa_lock(1234);print "LINE=".__LINE__."\n";
ReadMode 0;print "LINE=".__LINE__."\n";
chomp($passwd[0]);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$passwd[1]=$passwd[0];print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[0]) {
$passwd[1]=unpack('a8',$passwd[0])
}
print " Please Enter Old Password Again: ";print "LINE=".__LINE__."\n";
ReadMode 2;print "LINE=".__LINE__."\n";
&release_fa_lock(1234);print "LINE=".__LINE__."\n";
$pas=<STDIN>;print "LINE=".__LINE__."\n";
$pas=~/^(.*)$/;print "LINE=".__LINE__."\n";
$passwd[3]=$1;print "LINE=".__LINE__."\n";
&acquire_fa_lock(1234);print "LINE=".__LINE__."\n";
ReadMode 0;print "LINE=".__LINE__."\n";
chomp($passwd[3]);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$passwd[4]=$passwd[3];print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[3]) {
$passwd[4]=unpack('a8',$passwd[3])
}
if ($passwd[1] eq $passwd[4]) {
last;print "LINE=".__LINE__."\n";
} else {
if ($^O ne 'cygwin') {
print $blanklines;print "LINE=".__LINE__."\n";
} else {
print "$blanklines\n";print "LINE=".__LINE__."\n";
} print "\n Passwords did not match!\n";print "LINE=".__LINE__."\n";
}
}
while (1) {
print "\n Enter New Password: ";print "LINE=".__LINE__."\n";
ReadMode 2;print "LINE=".__LINE__."\n";
&release_fa_lock(1234);print "LINE=".__LINE__."\n";
$passwd[5]=<STDIN>;print "LINE=".__LINE__."\n";
&acquire_fa_lock(1234);print "LINE=".__LINE__."\n";
ReadMode 0;print "LINE=".__LINE__."\n";
chomp($passwd[5]);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$passwd[6]=$passwd[5];print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[5]) {
$passwd[6]=unpack('a8',$passwd[5])
}
print " Please Enter New Password Again: ";print "LINE=".__LINE__."\n";
ReadMode 2;print "LINE=".__LINE__."\n";
&release_fa_lock(1234);print "LINE=".__LINE__."\n";
$passwd[7]=<STDIN>;print "LINE=".__LINE__."\n";
&acquire_fa_lock(1234);print "LINE=".__LINE__."\n";
ReadMode 0;print "LINE=".__LINE__."\n";
chomp($passwd[7]);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$passwd[8]=$passwd[7];print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[7]) {
$passwd[8]=unpack('a8',$passwd[7])
}
if ($passwd[6] eq $passwd[8]) {
last;print "LINE=".__LINE__."\n";
} else {
if ($^O ne 'cygwin') {
print $blanklines;print "LINE=".__LINE__."\n";
} else {
print "$blanklines\n";print "LINE=".__LINE__."\n";
} print "\n Passwords did not match!\n";print "LINE=".__LINE__."\n";
}
}
my $cipher_algorithm=($oldcipher)?$oldcipher:
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'};print "LINE=".__LINE__."\n";
my $cipher = new Crypt::CBC($passwd[8],
$cipher_algorithm);print "LINE=".__LINE__."\n";
my $kind='prod';print "LINE=".__LINE__."\n";
$kind='test' if $Net::FullAuto::FA_Core::test
&& !$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB:".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
# print the contents of the file
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my ($k,$v) = ("","") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
my $href=eval $v;print "LINE=".__LINE__."\n";
foreach my $key (keys %{eval $v}) {
if ($key=~/\d+$/) {
while (delete $href->{$key}) {}
next
}
my $href_2='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($k,$href_2);print "LINE=".__LINE__."\n";
my $encrypted_passwd=$href_2->{$key};print "LINE=".__LINE__."\n";
my $pass=$cipher->decrypt($encrypted_passwd);print "LINE=".__LINE__."\n";
if ($pass && $pass!~tr/\0-\37\177-\377//) {
print "Updated $key\n";print "LINE=".__LINE__."\n";
while (delete $href->{$key}) {}
my $cipher = new Crypt::CBC($passwd[8],
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
my $new_encrypted=$cipher->encrypt($pass);print "LINE=".__LINE__."\n";
$href->{$key}=$new_encrypted;print "LINE=".__LINE__."\n";
} else { print "Skipping $key\n" }
} my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
my $status=$bdb->db_put($k,$put_href);print "LINE=".__LINE__."\n";
}
undef $cursor ;print "LINE=".__LINE__."\n";
undef $bdb ;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
}
&acquire_fa_lock(9876);print "LINE=".__LINE__."\n";
my $loop_count=0;print "LINE=".__LINE__."\n";
while (1) {
$loop_count++;print "LINE=".__LINE__."\n";
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/;print "LINE=".__LINE__."\n";
}
$MRLOG=*MRLOG;print "LINE=".__LINE__."\n";
my $die="Cannot Open LOGFILE - \"" .
$Hosts{"__Master_${$}__"}{'LogFile'} . "\"";print "LINE=".__LINE__."\n";
open ($MRLOG, ">$Hosts{\"__Master_${$}__\"}{'LogFile'}")
|| &handle_error($die);print "LINE=".__LINE__."\n";
unless ($quiet) {
print "\n LOGFILE ==> \"",
$Hosts{"__Master_${$}__"}{'LogFile'},"\"\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n LOGFILE ==> \"",
$Hosts{"__Master_${$}__"}{'LogFile'},"\"\n"])
if $cache;print "LINE=".__LINE__."\n";
}
$MRLOG->autoflush(1);print "LINE=".__LINE__."\n";
print $MRLOG "\n\n#### NEW PROCESS - ",
scalar localtime(time)," #####\n\n",
"#### COMMAND - $0 ",
(join " ",map { (-1<index $_,' ')?"\"$_\"":$_ } @ARGV),
" ####\n\n";print "LINE=".__LINE__."\n";
} elsif ($log) {
$MRLOG=*MRLOG;print "LINE=".__LINE__."\n";
my $olog="$home_dir/FAlog${$}d".
$Net::FullAuto::FA_Core::invoked[2].
$Net::FullAuto::FA_Core::invoked[3].".txt";print "LINE=".__LINE__."\n";
$Hosts{"__Master_${$}__"}{'LogFile'}=$olog;print "LINE=".__LINE__."\n";
open ($MRLOG, ">$olog") || &handle_error($!);print "LINE=".__LINE__."\n";
$MRLOG->autoflush(1);print "LINE=".__LINE__."\n";
unless ($quiet) {
print "\n LOGFILE ==> \"$olog\"\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n LOGFILE ==> \"$olog\"\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $MRLOG "\n\n#### NEW PROCESS - ",
scalar localtime(time)," #####\n\n",
"#### COMMAND - $0 ",
(join " ",map { (-1<index $_,' ')?"\"$_\"":$_ } @ARGV),
" ####\n\n";print "LINE=".__LINE__."\n";
}
}
if (defined $default || (defined $facode && !$facode)
|| (defined $faconf && !$faconf)
|| (defined $fahost && !$fahost)
|| (defined $famaps && !$famaps)
|| (defined $famenu && !$famenu)
|| (defined $set && !$set)) {
my $default_modules=$main::get_default_modules->();print "LINE=".__LINE__."\n";
if (defined $facode) {
my %define_module_fa_code=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Code'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Code'),
);print "LINE=".__LINE__."\n";
my $selection=Menu(\%define_module_fa_code);print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
} elsif (defined $faconf) {
my %define_module_fa_conf=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Conf'),
);print "LINE=".__LINE__."\n";
my $selection=Menu(\%define_module_fa_conf);print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
} elsif (defined $fahost) {
my %define_module_fa_host=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Host'),
);print "LINE=".__LINE__."\n";
my $selection=Menu(\%define_module_fa_host);print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
} elsif (defined $famaps) {
my %define_module_fa_maps=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Maps'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Maps'),
);print "LINE=".__LINE__."\n";
my $selection=Menu(\%define_module_fa_maps);print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
} elsif (defined $famenu) {
my %define_module_fa_menu=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Menu'),
);print "LINE=".__LINE__."\n";
my $selection=Menu(\%define_module_fa_menu);print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
} elsif (defined $set) {
$default_modules->{'set'}||='none';print "LINE=".__LINE__."\n";
my $current_default_set=$default_modules->{'set'};print "LINE=".__LINE__."\n";
&Menu($set_menu_sub->());print "LINE=".__LINE__."\n";
}
if (defined $famenu) {
set_fa_modules('menu',$default_modules);print "LINE=".__LINE__."\n";
} elsif (defined $facode) {
set_fa_modules('code',$default_modules);print "LINE=".__LINE__."\n";
} elsif (defined $fahost) {
set_fa_modules('host',$default_modules);print "LINE=".__LINE__."\n";
} elsif (defined $faconf) {
set_fa_modules('conf',$default_modules);print "LINE=".__LINE__."\n";
} elsif (defined $famaps) {
set_fa_modules('maps',$default_modules);print "LINE=".__LINE__."\n";
} elsif (defined $default) {
my $ca_sub=sub {
use File::Path;print "LINE=".__LINE__."\n";
use File::Copy;print "LINE=".__LINE__."\n";
my $type=$_[0];print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);print "LINE=".__LINE__."\n";
unless (-d "$fadir/Custom/$username/$type") {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
unless (-d "$fadir/Custom") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."$fadir/Custom";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d "$fadir/Custom/$username") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."$fadir/Custom/$username";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
unless (-d "$fadir/Custom/$username/$type") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m."$fadir/Custom/$username/$type";print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('cp').'cp '.
"$fadir/Custom/fa_".lc($type).'.pm '.
"$fadir/Custom/$username/$type";print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod').
"chmod -Rv $mode ".
"$fadir/Custom/$username/$type/*";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
die $stderr if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
}
opendir(DIR,"$fadir/Custom/$username/$type");print "LINE=".__LINE__."\n";
my @xfiles = readdir(DIR);print "LINE=".__LINE__."\n";
my @return=();print "LINE=".__LINE__."\n";
closedir(DIR);print "LINE=".__LINE__."\n";
foreach my $entry (@xfiles) {
next if $entry eq '.';print "LINE=".__LINE__."\n";
next if $entry eq '..';print "LINE=".__LINE__."\n";
next if -d $entry;print "LINE=".__LINE__."\n";
push @return, $entry;print "LINE=".__LINE__."\n";
}
return @return;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
$defaults_sub->($default_modules);print "LINE=".__LINE__."\n";
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
my $selection=Menu($viewdefaults_sub->());print "LINE=".__LINE__."\n";
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults') ||
($selection eq 'Finished Default Module')) {
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
}
#print "SELECTION=$selection\n";sleep 5;print "LINE=".__LINE__."\n";
} else {
my $selection=Menu($defaultsettings_sub->());print "LINE=".__LINE__."\n";
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults')) {
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&cleanup();print "LINE=".__LINE__."\n";
}
}
}
}
if ($plan || $plan_ignore_error) {
if ($Net::FullAuto::cpu) {
my $idle=(split ',', $Net::FullAuto::cpu)[3];print "LINE=".__LINE__."\n";
$idle=~s/^\s*//;print "LINE=".__LINE__."\n";
$idle=~s/%.*$//;print "LINE=".__LINE__."\n";
my $cpyou=100-$idle;print "LINE=".__LINE__."\n";
if ($idle<20) {
my $die="FATAL ERROR - CPU Usage is too high\n"
." to run FullAuto safely.\n"
." CPU are Starttime ==> ${cpyou}%\n";print "LINE=".__LINE__."\n";
&handle_error($die);print "LINE=".__LINE__."\n";
}
}
$plan||=$plan_ignore_error;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => ${Net::FullAuto::FA_Core::progname}.
"_plans.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_plans.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_plans.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track) unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
my $pref='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($plan,$pref);print "LINE=".__LINE__."\n";
$pref=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
my $pla_n=eval $pref;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $MRLOG $die
if $log && -1<index $MRLOG,'*';print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
}
if ($admin && !defined $main::plan_menu_sub) {
$Net::FullAuto::FA_Core::adminmenu->();print "LINE=".__LINE__."\n";
}
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");print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}->print('exit');print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$line=~s/\s//g;print "LINE=".__LINE__."\n";
my $allout.=$line;print "LINE=".__LINE__."\n";
last if $allout=~/logout|closed/s;print "LINE=".__LINE__."\n";
} $localhost->{_cmd_handle}->close;print "LINE=".__LINE__."\n";
}
} elsif ($cmd_type eq 'ssh') {
$localhost->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}->close;
} elsif (exists $localhost->{_cmd_handle}) {
$localhost->{_cmd_handle}->close;print "LINE=".__LINE__."\n";
}
}
if ($login_Mast_error) {
if ($login_Mast_error=~/[Ll]ogin|sion den|Passwo/) {
$userflag=0;@passwd=();print "LINE=".__LINE__."\n";
chomp($login_Mast_error);print "LINE=".__LINE__."\n";
$login_Mast_error=~s/^(.*try again.).*$/$1\n/s;print "LINE=".__LINE__."\n";
} else {
chomp($login_Mast_error);print "LINE=".__LINE__."\n";
}
}
if (!$userflag && !$cron || !$username) {
my $uid=$username;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron) {
while (1) {
if ($^O ne 'cygwin') {
print $blanklines;print "LINE=".__LINE__."\n";
} else {
print "$blanklines\n";print "LINE=".__LINE__."\n";
}
if ($login_Mast_error) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n ERROR MESSAGE (5) -> $login_Mast_error";print "LINE=".__LINE__."\n";
} else {
print "\n ERROR MESSAGE -> $login_Mast_error";print "LINE=".__LINE__."\n";
}
}
if ($test && !$prod) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n Running in TEST (2) mode\n";print "LINE=".__LINE__."\n";
} else {
print "\n Running in TEST mode\n";print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
print "\n Running in PRODUCTION (2) mode\n";print "LINE=".__LINE__."\n";
} else {
print "\n Running in PRODUCTION mode\n";print "LINE=".__LINE__."\n";
}
}
my $usrname_timeout=350;print "LINE=".__LINE__."\n";
my $usrname='';print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($usrname_timeout);print "LINE=".__LINE__."\n";
&acquire_fa_lock(1234);print "LINE=".__LINE__."\n";
my $ikey='';print "LINE=".__LINE__."\n";
print "\n";print "LINE=".__LINE__."\n";
($usrname,$ikey)=rawInput(" $hostname Login <$uid> : ");print "LINE=".__LINE__."\n";
&release_fa_lock(1234);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@ eq "alarm\n") {
print "\n\n";print "LINE=".__LINE__."\n";
&handle_error(
"Time Allowed for Username Input has Expired.",
'__cleanup__');print "LINE=".__LINE__."\n";
}
chomp $usrname;print "LINE=".__LINE__."\n";
$usrname=~s/^\s*//s;print "LINE=".__LINE__."\n";
$usrname=~s/\s*$//s;print "LINE=".__LINE__."\n";
next if $usrname=~/^\d/ || !$usrname && !$uid;print "LINE=".__LINE__."\n";
$username= ($usrname) ? $usrname : $uid;print "LINE=".__LINE__."\n";
$username_from='user_input';print "LINE=".__LINE__."\n";
$userflag=1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} else {
&handle_error($login_Mast_error);print "LINE=".__LINE__."\n";
}
}
my $kind='prod';print "LINE=".__LINE__."\n";
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",
'',$track);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $href={};print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
if (exists $href->{"gatekeep_$username"}) {
my $zyxarray=$href->{"passetts_$username"};print "LINE=".__LINE__."\n";
$zyxarray=~s/\$ARRAY\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$passetts=eval $zyxarray;print "LINE=".__LINE__."\n";
undef $zyxarray;print "LINE=".__LINE__."\n";
my $ignore_expiration=$passetts->[1]||0;print "LINE=".__LINE__."\n";
my $now=time;print "LINE=".__LINE__."\n";
#print "WHAT IS IGNORED EXP=$ignore_expiration and PASSWORD FROM=$password_from\n";print "LINE=".__LINE__."\n";
if ($now<$ignore_expiration) {
$passetts->[9]=$dcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
my $rstr=new String::Random;print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");print "LINE=".__LINE__."\n";
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");print "LINE=".__LINE__."\n";
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
my $tpess=$dcipher->decrypt($passetts->[0]);print "LINE=".__LINE__."\n";
my $skipflag=0;print "LINE=".__LINE__."\n";
if ($password_from ne 'user_input') {
if ($passwd[0] ne $tpess) {
undef $tpess;print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt($passwd[0]);print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
$skipflag=1;print "LINE=".__LINE__."\n";
undef $passwd[0];print "LINE=".__LINE__."\n";
} else {
print "\n Saved Password matches outside input!\n";
}
}
unless ($skipflag) {
undef $tpess;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print "\n Saved Password will Expire: ",
scalar localtime($ignore_expiration)."\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n"])
if $cache;print "LINE=".__LINE__."\n";
}
$tpess=$ecipher->encrypt(
$dcipher->decrypt($passetts->[0]));print "LINE=".__LINE__."\n";
my $arr=[$tpess,$ignore_expiration];print "LINE=".__LINE__."\n";
undef $tpess;print "LINE=".__LINE__."\n";
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump($arr)->Out();print "LINE=".__LINE__."\n";
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put('localhost',$put_href);print "LINE=".__LINE__."\n";
}
$save_main_pass=0;print "LINE=".__LINE__."\n";
} elsif ($password_from ne 'user_input') {
my $rstr=new String::Random;print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");print "LINE=".__LINE__."\n";
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");print "LINE=".__LINE__."\n";
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt($passwd[0]);print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
$save_main_pass=1;print "LINE=".__LINE__."\n";
undef $passwd[0];print "LINE=".__LINE__."\n";
} else {
print "\n NOTICE!: Saved Password --EXPIRED-- on ".
scalar localtime($ignore_expiration)."\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n NOTICE!: Saved Password --EXPIRED-- on ".
scalar localtime($ignore_expiration)."\n"])
if $cache;print "LINE=".__LINE__."\n";
my $passwd_timeout=350;print "LINE=".__LINE__."\n";
my $pas='';print "LINE=".__LINE__."\n";
my $te_time=time;print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9854);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
print "\n Password (2): ";print "LINE=".__LINE__."\n";
} else {
print "\n Password: ";print "LINE=".__LINE__."\n";
}
ReadMode 2;print "LINE=".__LINE__."\n";
$pas=<STDIN>;print "LINE=".__LINE__."\n";
&release_fa_lock(9854);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@ eq "alarm\n") {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n\n"]) if $cache;print "LINE=".__LINE__."\n";
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');print "LINE=".__LINE__."\n";
}
my $te_time2=time;print "LINE=".__LINE__."\n";
if (10<$loop_count
|| (($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
print "\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n"]) if $cache;print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
}
$pas=~/^(.*)$/;print "LINE=".__LINE__."\n";
$passwd[0]=$1;print "LINE=".__LINE__."\n";
chomp($passwd[0]);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n\n"]) if $cache;print "LINE=".__LINE__."\n";
my $rstr=new String::Random;print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");print "LINE=".__LINE__."\n";
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");print "LINE=".__LINE__."\n";
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt($passwd[0]);print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
$save_main_pass=1;print "LINE=".__LINE__."\n";
undef $passwd[0];print "LINE=".__LINE__."\n";
}
} elsif ($passwd[0]) {
my $rstr=new String::Random;print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");print "LINE=".__LINE__."\n";
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");print "LINE=".__LINE__."\n";
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt($passwd[0]);print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
undef $passwd[0];print "LINE=".__LINE__."\n";
#print "WHAT IS GATEKEEP=",$href->{"gatekeep_$username"},"\n";print "LINE=".__LINE__."\n";
} else {
#print "LOGIN_MAST_ERROR2=$login_Mast_error and BDB=$bdb<==\n";print "LINE=".__LINE__."\n";
my $passwd_timeout=350;print "LINE=".__LINE__."\n";
my $pas='';print "LINE=".__LINE__."\n";
my $te_time=time;print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9854);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
print "\n\n Password (3): ";print "LINE=".__LINE__."\n";
} else {
print "\n\n Password: ";print "LINE=".__LINE__."\n";
}
ReadMode 2;print "LINE=".__LINE__."\n";
$pas=<STDIN>;print "LINE=".__LINE__."\n";
&release_fa_lock(9854);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $te_time2=time;print "LINE=".__LINE__."\n";
if ($@ eq "alarm\n") {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n\n"]) if $cache;print "LINE=".__LINE__."\n";
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');print "LINE=".__LINE__."\n";
}
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
print "\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n"]) if $cache;print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
}
$pas||='';print "LINE=".__LINE__."\n";
$pas=~/^(.*)$/;print "LINE=".__LINE__."\n";
$passwd[0]=$1;print "LINE=".__LINE__."\n";
chomp($passwd[0]);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
my $rstr=new String::Random;print "LINE=".__LINE__."\n";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");print "LINE=".__LINE__."\n";
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");print "LINE=".__LINE__."\n";
}
#print "WHAT IS GATEKEEP2=",$href->{"gatekeep_$username"},"\n";print "LINE=".__LINE__."\n";
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt($passwd[0]);print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
undef $passwd[0];print "LINE=".__LINE__."\n";
}
} elsif ((!$Net::FullAuto::FA_Core::dcipher ||
!$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]))
&& !$Net::FullAuto::FA_Core::cron && !$identity_file) {
my $passwd_timeout=350;print "LINE=".__LINE__."\n";
my $pas='';print "LINE=".__LINE__."\n";
my $te_time=time;print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9854);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
print "\n\n Password (4): ";print "LINE=".__LINE__."\n";
} else {
print "\n\n Password: ";print "LINE=".__LINE__."\n";
}
ReadMode 2;print "LINE=".__LINE__."\n";
$pas=<STDIN>;print "LINE=".__LINE__."\n";
&release_fa_lock(9854);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $te_time2=time;print "LINE=".__LINE__."\n";
if ($@ eq "alarm\n") {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n\n"]) if $cache;print "LINE=".__LINE__."\n";
&handle_error(
"Input Time Limit for Password Prompt:\n\n".
" Password: Expired");print "LINE=".__LINE__."\n";
}
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
print "\n<---";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n<---"]) if $cache;print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
}
#print "LOGIN_MAST_ERROR=$login_Mast_error<== AND NO BDB\n";print "LINE=".__LINE__."\n";
$pas=~/^(.*)$/;print "LINE=".__LINE__."\n";
$passwd[0]=$1;print "LINE=".__LINE__."\n";
chomp($passwd[0]);print "LINE=".__LINE__."\n";
my $status=$bdb->db_get('localhost',$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
my $pselection='';print "LINE=".__LINE__."\n";
my $ignore_expiration=0;print "LINE=".__LINE__."\n";
if (exists $href->{"gatekeep_$username"}) {
my $zyxarray=$href->{"passetts_$username"};print "LINE=".__LINE__."\n";
$zyxarray=~s/\$ARRAY\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$passetts=eval $zyxarray;print "LINE=".__LINE__."\n";
undef $zyxarray;print "LINE=".__LINE__."\n";
$ignore_expiration=$passetts->[1]||0;print "LINE=".__LINE__."\n";
my $now=time;print "LINE=".__LINE__."\n";
my $tdcipher='';print "LINE=".__LINE__."\n";
#print "WHAT IS IGNORED EXP=$ignore_expiration and PASSWORD FROM=$password_from\n";print "LINE=".__LINE__."\n";
if ($now<$ignore_expiration) {
$tdcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
if ($passwd[0] eq $tdcipher->decrypt($passetts->[0])) {
my %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, always be sure to start FullAuto\n".
" with the --password argument.\n\n".
" (Saved Passwords are NEVER recommended\n".
" and are ALWAYS an increased security risk\n".
" - but are allowed for unattended mode and\n".
" for making interactive use easier and\n".
" more efficient - like during custom code\n".
" development. Always use sparingly.)\n\n".
" *NO* password should ever be typed after\n".
" the --password argument. FullAuto DOES\n".
" *NOT* support command line argument\n".
" passing of passwords. It is a VERY\n".
" insecure and highly discouraged practice!)."
);print "LINE=".__LINE__."\n";
$pselection=&Menu(\%askaboutpass);print "LINE=".__LINE__."\n";
cleanup() if $pselection eq ']quit[';print "LINE=".__LINE__."\n";
}
}
}
my $rstr=new String::Random;print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'Cipher'}
&& $Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");print "LINE=".__LINE__."\n";
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");print "LINE=".__LINE__."\n";
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt($passwd[0]);print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
undef $passwd[0];print "LINE=".__LINE__."\n";
if ($pselection ne 'Keep the Saved Password') {
delete $href->{"gatekeep_$username"};print "LINE=".__LINE__."\n";
} else {
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print "\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n"])
if $cache;print "LINE=".__LINE__."\n";
}
my $tpess=$ecipher->encrypt(
$dcipher->decrypt($passetts->[0]));print "LINE=".__LINE__."\n";
my $arr=[$tpess,$ignore_expiration];print "LINE=".__LINE__."\n";
undef $tpess;print "LINE=".__LINE__."\n";
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump($arr)->Out();print "LINE=".__LINE__."\n";
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put('localhost',$put_href);print "LINE=".__LINE__."\n";
print "\n\n";print "LINE=".__LINE__."\n";
} else {
my $rstr=new String::Random;print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'Cipher'}
&& $Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");print "LINE=".__LINE__."\n";
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");print "LINE=".__LINE__."\n";
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt($passwd[0]);print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
undef $passwd[0];print "LINE=".__LINE__."\n";
}
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
$login_id=$username;print "LINE=".__LINE__."\n";
$passwd[2]='';print "LINE=".__LINE__."\n";
$passetts->[2]='';print "LINE=".__LINE__."\n";
$host='localhost';print "LINE=".__LINE__."\n";
my $lc_cnt=-1;print "LINE=".__LINE__."\n";
$localhost={};my $local_host='';print "LINE=".__LINE__."\n";
$localhost=bless $localhost, 'Rem_Command';print "LINE=".__LINE__."\n";
bless $localhost,
substr($Net::FullAuto::FA_Core::custom_code_module_file,0,-3);print "LINE=".__LINE__."\n";
&acquire_fa_lock(6543);print "LINE=".__LINE__."\n";
foreach my $connect_method (@RCM_Link) {
$lc_cnt++;print "LINE=".__LINE__."\n";
if (lc($connect_method) eq 'telnet') {
$cmd_type='telnet';print "LINE=".__LINE__."\n";
my $telnetpath=$Net::FullAuto::FA_Core::gbp->('telnet');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'telnet'}) {
$telnetpath=$Hosts{"__Master_${$}__"}{'telnet'};print "LINE=".__LINE__."\n";
$telnetpath.='/' if $telnetpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $telnetport=$Net::FullAuto::FA_Core::gbp->('telnet');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'telnetport'}) {
$telnetport=$Hosts{"__Master_${$}__"}{'telnetport'};print "LINE=".__LINE__."\n";
}
if ($telnetport) {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
["${telnetpath}telnet",'localhost'])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch telnet subprocess"));print "LINE=".__LINE__."\n";
} else {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
["${telnetpath}telnet",'localhost'],$telnetport)
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch telnet subprocess"));print "LINE=".__LINE__."\n";
}
#print "CMD_PID=$cmd_pid<======\n";print "LINE=".__LINE__."\n";
$localhost->{_cmd_pid}=$cmd_pid;print "LINE=".__LINE__."\n";
$localhost->{_cmd_type}=$cmd_type;print "LINE=".__LINE__."\n";
$localhost->{_connect}=$_connect;print "LINE=".__LINE__."\n";
$localhost->{_uname}=$^O;print "LINE=".__LINE__."\n";
$localhost->{_hostlabel}=
[ "__Master_${$}__",'' ];print "LINE=".__LINE__."\n";
$local_host=Net::Telnet->new(Fhopen => $localhost,
Timeout => $fatimeout);print "LINE=".__LINE__."\n";
$local_host->telnetmode(0);print "LINE=".__LINE__."\n";
$local_host->binmode(1);print "LINE=".__LINE__."\n";
$local_host->output_record_separator("\r");print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}->close()
if exists $localhost->{_cmd_handle};print "LINE=".__LINE__."\n";
delete $localhost->{_cmd_handle}
if exists $localhost->{_cmd_handle};print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}=$local_host;print "LINE=".__LINE__."\n";
while (my $line=$local_host->get) {
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
#print "OUTPUT FROM NEW::TELNET=$line<==\n";print "LINE=".__LINE__."\n";
#print $Net::FullAuto::FA_Core::MRLOG "OUTPUT FROM NEW::TELNET=$line<==\n";print "LINE=".__LINE__."\n";
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (7<length $line && unpack('a8',$line) eq 'Insecure') {
$line=~s/^Insecure/INSECURE/s;print "LINE=".__LINE__."\n";
if (wantarray) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
return '',$line;print "LINE=".__LINE__."\n";
} else { &release_fa_lock(6543);die $line }
}
last if $line!~/Last login/i &&
$line=~/login[: ]*$|username[: ]*$/i;print "LINE=".__LINE__."\n";
}
$local_host->print($login_id);print "LINE=".__LINE__."\n";
if ($local_host->errmsg) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
&handle_error($local_host->errmsg,'-1')
}
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
$localhost,$timeout);print "LINE=".__LINE__."\n";
if ($stderr) {
if ($lc_cnt==$#RCM_Link) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
die $stderr;print "LINE=".__LINE__."\n";
} else { next }
} last
} elsif (lc($connect_method) eq 'ssh') {
$cmd_type='ssh';print "LINE=".__LINE__."\n";
my $sshpath='';my $idntfil='';print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'ssh'}) {
$sshpath=$Hosts{"__Master_${$}__"}{'ssh'};print "LINE=".__LINE__."\n";
$sshpath.='/' if $sshpath!~/\/$/;print "LINE=".__LINE__."\n";
}
if (exists $Hosts{"__Master_${$}__"}{'sshport'}) {
$sshport=$Hosts{"__Master_${$}__"}{'sshport'};print "LINE=".__LINE__."\n";
}
if (exists $Hosts{"__Master_${$}__"}{'identity_file'}) {
$idntfil=$Hosts{"__Master_${$}__"}{'identity_file'};print "LINE=".__LINE__."\n";
}
$idntfil=$identity_file if $identity_file;print "LINE=".__LINE__."\n";
my $try_count=0;print "LINE=".__LINE__."\n";
while (1) {
if ($sshport) {
if ($idntfil) {
if ($Net::FullAuto::FA_Core::debug) {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
#["${sshpath}ssh","-caes128-ctr","-p$sshport",
["${sshpath}ssh","-p$sshport","-i$idntfil",
"-vvv","$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
["${sshpath}ssh","-p$sshport","-i$idntfil",
"$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
#["${sshpath}ssh","-caes128-ctr","-p$sshport",
["${sshpath}ssh","-p$sshport",
"-vvv","$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
} else {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
["${sshpath}ssh","-p$sshport",
"$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
}
}
} elsif ($idntfil) {
if ($Net::FullAuto::FA_Core::debug) {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
#["${sshpath}ssh","-caes128-ctr","$login_id\@localhost",
["${sshpath}ssh","-i$idntfil","$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
} else {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
#["${sshpath}ssh","-caes128-ctr","$login_id\@localhost",
["${sshpath}ssh","-vvv","-i$idntfil",
"$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
#["${sshpath}ssh","-caes128-ctr","$login_id\@localhost",
["${sshpath}ssh","-vvv","$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
} 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_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));print "LINE=".__LINE__."\n";
}
}
$localhost->{_cmd_pid}=$cmd_pid;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$localhost->{_cmd_type}=$cmd_type;print "LINE=".__LINE__."\n";
$localhost->{_connect}=$_connect;print "LINE=".__LINE__."\n";
$localhost->{_uname}=$^O;print "LINE=".__LINE__."\n";
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];print "LINE=".__LINE__."\n";
$local_host=Net::Telnet->new(Fhopen => $local_host,
Timeout => $fatimeout);print "LINE=".__LINE__."\n";
$local_host->telnetmode(0);print "LINE=".__LINE__."\n";
$local_host->binmode(1);print "LINE=".__LINE__."\n";
$local_host->output_record_separator("\r");print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}->close()
if exists $localhost->{_cmd_handle};print "LINE=".__LINE__."\n";
$localhost->{_cmd_handle}=$local_host;print "LINE=".__LINE__."\n";
unless ($idntfil) {
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$local_host,
_hostlabel=>[ "__Master_${$}__",'' ],
_cmd_type=>'ssh',
_connect=>$_connect },$timeout);print "LINE=".__LINE__."\n";
if ($stderr) {
if ($lc_cnt==$#RCM_Link) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
die $stderr;print "LINE=".__LINE__."\n";
} elsif (-1<index $stderr,'read timed-out:do_slave') {
# TEST HERE FOR NO LOCALHOST SSH CONNECTIVITY
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
($stdout,$stderr)=&kill($cmd_pid,$kill_arg)
if &testpid($cmd_pid);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::slave='_slave_';next
} elsif (3<$try_count++) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
} else { sleep 1;next }
} last
} 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,'*';print "LINE=".__LINE__."\n";
$local_host->print($dcipher->decrypt($passetts->[0]));print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
if ($^O ne 'cygwin') {
print $blanklines;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,$blanklines]) if $cache;print "LINE=".__LINE__."\n";
} else {
unless ($login_Mast_error) {
print "\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
}
# Logging (1)
unless ($login_Mast_error) {
print "--> Logging into $host via $cmd_type",
" . . .\n\n" unless $login_Mast_error;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"--> Logging into $host via $cmd_type".
" . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
} elsif ($Net::FullAuto::FA_Core::debug) {
if ($login_Mast_error) {
print "LOGIN MASTER HOST ERROR: ",
"$login_Mast_error\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"LOGIN MASTER HOST ERROR: ".
"$login_Mast_error\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print "--> Logging (1) into $host via $cmd_type",
" . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"--> Logging (1) into $host via $cmd_type",
" . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
my $newpw='';$passline=__LINE__+1;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $output='';print "LINE=".__LINE__."\n";
($output=$line)=~s/login:.*//s;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
my $pass_test=$dcipher->decrypt($passetts->[0]);print "LINE=".__LINE__."\n";
$pass_test=~s/[(]/\\(/g;print "LINE=".__LINE__."\n";
$pass_test=~s/[)]/\\)/g;print "LINE=".__LINE__."\n";
if ($line=~/^$pass_test\n/) {
undef $pass_test;print "LINE=".__LINE__."\n";
$local_host->print("\032");print "LINE=".__LINE__."\n";
$local_host->close;print "LINE=".__LINE__."\n";
$passerror=1;print "LINE=".__LINE__."\n";
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
return;print "LINE=".__LINE__."\n";
} else {
undef $pass_test;print "LINE=".__LINE__."\n";
}
}
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|DB_PRIVATE
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
&handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track);print "LINE=".__LINE__."\n";
}
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils(
'recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".${Net::FullAuto::FA_Core::progname}.
"_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
unless ($BerkeleyDB::Error=~/Successful/) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track);print "LINE=".__LINE__."\n";
}
my $href={};print "LINE=".__LINE__."\n";
my $status=$bdb->db_get('localhost',$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
if (exists $href->{"gatekeep_$username"}) {
my $tdcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
if ($dcipher->decrypt($passetts->[0]) eq
$tdcipher->decrypt($passetts->[0])) {
delete $href->{"gatekeep_$username"};print "LINE=".__LINE__."\n";
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put('localhost',$put_href);print "LINE=".__LINE__."\n";
}
}
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
## ADD - TELL USER ABOUT MISSING CRON CREDS ON CMD LINE
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
die $line;print "LINE=".__LINE__."\n";
} elsif (-1<index $line,'/bin/bash: Operation not permitted') {
my $srvaccount=`sc qc sshd`;print "LINE=".__LINE__."\n";
$srvaccount=~s/^.*SERVICE_START_NAME : (?:.\\)*(.*?)\s*$/$1/s;print "LINE=".__LINE__."\n";
$line=~s/^/ /gm;print "LINE=".__LINE__."\n";
$line=~s/\s*$//s;print "LINE=".__LINE__."\n";
my $die="FATAL ERROR! - There may be unknown priviliges missing\n\n".
" from the ID: '".$srvaccount."'\n\n".
" needed for the Cygwin sshd service on this host.\n".
" No attempt was made to add these priviliges, because\n".
" the user \'$username\' *appears* to lack sufficient\n".
" administrative rights on this host. If so, please\n".
" contact your Domain and/or System Administrators for\n".
" assistance. These priviliges may be controlled at\n".
" the domain level with a global policy that affects\n".
" one or multiple hosts. These policies are enforced\n".
" at host startup. More information is available to\n".
" accounts running FullAuto with administrative rights.\n".
"\n$line\n\n".
" HINT: When opening terminal in Windows, right click\n".
" on icon and select \"Run as administrator\"\n";print "LINE=".__LINE__."\n";
&handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
if ($line=~/Connection reset by peer|node or service name/s) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
die $line;print "LINE=".__LINE__."\n";
}
if ($line=~/(?<!Last )login[: ]*$/m ||
(-1<index $line,' sync_with_child: ')) {
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
&handle_error($output,'__cleanup__');print "LINE=".__LINE__."\n";
}
if ($line=~/new password: ?$/is) {
$newpw=$line;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "GOING LAST ONE<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} elsif ($line=~/[:\$%>#-] ?/m) {
print $Net::FullAuto::FA_Core::MRLOG "<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG "GOT OUT OF COMMANDPROMPT<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
&change_pw($localhost) if $newpw;print "LINE=".__LINE__."\n";
## Make sure prompt won't match anything in send data.
$local_host->prompt("/_funkyPrompt_\$/");print "LINE=".__LINE__."\n";
$local_host->print("export PS1=_funkyPrompt_;unset PROMPT_COMMAND");print "LINE=".__LINE__."\n";
$localhost->{_ftm_type}='';print "LINE=".__LINE__."\n";
$localhost->{_cwd}='';print "LINE=".__LINE__."\n";
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];print "LINE=".__LINE__."\n";
$localhost->{_hostname}=$hostname;print "LINE=".__LINE__."\n";
$localhost->{_ip}=$ip;print "LINE=".__LINE__."\n";
$localhost->{_connect}=$_connect;print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
my $wloop=0;print "LINE=".__LINE__."\n";
foreach my $host (keys %same_host_as_Master) {
if (exists $Hosts{$host}{'LoginID'} &&
($Hosts{$host}{'LoginID'} ne $username) &&
!exists $Hosts{$host}{'sshport'}) {
$Hosts{$host}{'LoginID'}=$username;print "LINE=".__LINE__."\n";
}
}
if (exists $Hosts{"__Master_${$}__"}{'SU_ID'}) {
my $ignore='';my $su_err='';print "LINE=".__LINE__."\n";
my $su_id=$Hosts{"__Master_${$}__"}{'SU_ID'};print "LINE=".__LINE__."\n";
&release_fa_lock(6543);print "LINE=".__LINE__."\n";
($ignore,$su_err)=&su($localhost->{_cmd_handle},$hostlabel,
$username,$su_id,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);print "LINE=".__LINE__."\n";
&handle_error($su_err,'-1') if $su_err;print "LINE=".__LINE__."\n";
&acquire_fa_lock(6543);print "LINE=".__LINE__."\n";
}
while (1) {
my $_sh_pid='';print "LINE=".__LINE__."\n";
($_sh_pid,$stderr)=Rem_Command::cmd(
$localhost,'echo $$');print "LINE=".__LINE__."\n";
# --CONTINUE-- print "LOCAL_sh_pid=$_sh_pid<==\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
$_sh_pid||=0;print "LINE=".__LINE__."\n";
$_sh_pid=~/^(.*)$/;print "LINE=".__LINE__."\n";
$_sh_pid=$1||'';print "LINE=".__LINE__."\n";
chomp($_sh_pid=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$localhost->{_sh_pid}=$_sh_pid;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (!$localhost->{_sh_pid}) {
$localhost->print;print "LINE=".__LINE__."\n";
$localhost->print(
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;echo $$;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');print "LINE=".__LINE__."\n";
my $allins='';my $ct=0;print "LINE=".__LINE__."\n";
while (1) {
eval {
while (my $line=$localhost->get(
Timeout=>5)) {
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
$allins.=$line;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($allins=~/!!(.*)%%/) {
$localhost->{_sh_pid}=$1;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($@) {
$localhost->print;print "LINE=".__LINE__."\n";
} elsif (!$localhost->{_sh_pid} && $ct++<50) {
$localhost->print;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
} else { last }
last if $localhost->{_sh_pid} && $localhost->{_sh_pid}=~/^\d+$/;print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
if ($stderr || $wloop++==10) {
&handle_error($stderr);print "LINE=".__LINE__."\n";
}
}
&su_scrub($hostlabel) if $su_scrub;print "LINE=".__LINE__."\n";
my $switch_user='';print "LINE=".__LINE__."\n";
if (!$mainuser && (exists $Hosts{$hostlabel}{'LoginID'}) &&
($Hosts{$hostlabel}{'LoginID'} ne $login_id)) {
$switch_user=$Hosts{$hostlabel}{'LoginID'};print "LINE=".__LINE__."\n";
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});print "LINE=".__LINE__."\n";
$passetts->[0]=$ecipher->encrypt(
&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$switch_user,'',$stderr,
'__su__'));print "LINE=".__LINE__."\n";
$passetts->[9]=$dcipher=$ecipher;print "LINE=".__LINE__."\n";
$login_id=$username=$switch_user;print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
}
$kind='prod';print "LINE=".__LINE__."\n";
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
$dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $local_host_flag=0;print "LINE=".__LINE__."\n";
my $host__label='';print "LINE=".__LINE__."\n";
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
# --CONTINUE-- print "WHAT ARE HOSTLAB that are SAME AS MASTER=$hostlab<==\n";print "LINE=".__LINE__."\n";
next if $hostlab eq "__Master_${$}__";print "LINE=".__LINE__."\n";
$host__label=$hostlab;print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
if (!$local_host_flag) {
$host__label=$Net::FullAuto::FA_Core::local_hostname;print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
} elsif (exists $same_host_as_Master{$hostlabel}) {
$local_host_flag=1;print "LINE=".__LINE__."\n";
$host__label=$hostlabel;print "LINE=".__LINE__."\n";
} else { $host__label=$hostlabel }
my $key='';print "LINE=".__LINE__."\n";
if ($local_host_flag) {
$key="${login_id}_X_"
."${host__label}_X_${$}_X_$invoked[0]";print "LINE=".__LINE__."\n";
} else {
$key="${username}_X_${login_id}_X_${host__label}";print "LINE=".__LINE__."\n";
}
my $lref={};print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($host__label,$lref);print "LINE=".__LINE__."\n";
$lref=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$lref=eval $lref;print "LINE=".__LINE__."\n";
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_".$$."__";print "LINE=".__LINE__."\n";
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'});print "LINE=".__LINE__."\n";
} else {
$cipher = new Crypt::CBC($dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
} else {
$cipher = new Crypt::CBC($dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
my $new_encrypted=$cipher->encrypt(
$dcipher->decrypt($passetts->[0]));print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$lref->{$key}=$new_encrypted;print "LINE=".__LINE__."\n";
my $put_lref=Data::Dump::Streamer::Dump($lref)->Out();print "LINE=".__LINE__."\n";
my $status=$bdb->db_put($host__label,$put_lref);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "BDB STATUS=$status<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
} else {
#$tosspass{$key}=$passwd[0];print "LINE=".__LINE__."\n";
$tosspass{$key}=$dcipher->decrypt($passetts->[0]);print "LINE=".__LINE__."\n";
}
if ($save_main_pass) {
$passetts->[1]=$Net::FullAuto::FA_Core::choose_pass_expiration->();print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print "\n Saved Password will Expire: ",
scalar localtime($passetts->[1])."\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n Saved Password will Expire: ".
scalar localtime($passetts->[1])."\n"])
if $cache;print "LINE=".__LINE__."\n";
sleep 2;print "LINE=".__LINE__."\n";
}
my @tpass=@{$passetts}[0..1];print "LINE=".__LINE__."\n";
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump(\@tpass)->Out();print "LINE=".__LINE__."\n";
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
my $status=$bdb->db_put('localhost',$put_href);print "LINE=".__LINE__."\n";
}
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
if ($switch_user) {
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$su_err)=&su($local_host,$hostlabel,
$username,$switch_user,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);print "LINE=".__LINE__."\n";
&handle_error($su_err,'-1') if $su_err;print "LINE=".__LINE__."\n";
}
if (($^O ne 'cygwin') && $su_id) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle(
$local_host);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$su_err)=&su($local_host,$hostlabel,
$login_id,$su_id,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);print "LINE=".__LINE__."\n";
&handle_error($su_err,'-1') if $su_err;print "LINE=".__LINE__."\n";
}
if ($^O eq 'cygwin') {
my $wloop=0;print "LINE=".__LINE__."\n";
while (1) {
&acquire_fa_lock(8712);print "LINE=".__LINE__."\n";
($localhost->{_cygdrive},$stderr)=
Rem_Command::cmd(
$localhost,
$Net::FullAuto::FA_Core::gbp->('mount')."mount -p");print "LINE=".__LINE__."\n";
&release_fa_lock(8712);print "LINE=".__LINE__."\n";
$localhost->{_cygdrive}=~s/^.*(\/\S+).*$/$1/s;print "LINE=".__LINE__."\n";
last if $localhost->{_cygdrive} && unpack('a1',
$localhost->{_cygdrive}) eq '/';print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle(
$local_host);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1')
} $localhost->{_cygdrive_regex}=
qr/^$localhost->{_cygdrive}\//;print "LINE=".__LINE__."\n";
}
$localhost->{_work_dirs}=&master_transfer_dir(
$localhost);print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
$localhost->{_cwd}=$localhost->{_work_dirs}->{_pre_mswin};print "LINE=".__LINE__."\n";
} else {
$localhost->{_cwd}=$localhost->{_work_dirs}->{_pre};print "LINE=".__LINE__."\n";
}
if ($su_id) {
$Connections{"__Master_${$}____%-$su_id"}
=$localhost;print "LINE=".__LINE__."\n";
} else {
$Connections{"__Master_${$}____%-$login_id"}
=$localhost;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
if ($passerror) {
$passerror=0;next;print "LINE=".__LINE__."\n";
} elsif ($@) {
print "WHAT IS THE ERRORRRRR=$@\n";<STDIN>;print "LINE=".__LINE__."\n";
if (7<length $@) {
if (unpack('a8',$@) eq 'Insecure') {
print $@;cleanup();print "LINE=".__LINE__."\n";
} elsif (unpack('a8',$@) eq 'INSECURE') {
$@=~s/INSECURE/Insecure/s;print "LINE=".__LINE__."\n";
}
}
$username=&Net::FullAuto::FA_Core::username()
|| "Intruder!!" if !$username;print "LINE=".__LINE__."\n";
$login_id=$username if !$login_id;print "LINE=".__LINE__."\n";
$login_Mast_error=$@;print "LINE=".__LINE__."\n";
$localhost->{_sh_pid}||='';print "LINE=".__LINE__."\n";
$localhost->{_cmd_pid}||='';print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
unless ($localhost->{_sh_pid}) {
my $pspath=$Net::FullAuto::FA_Core::gbp->('ps');print "LINE=".__LINE__."\n";
my $ps_out=`${pspath}ps -el`;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
foreach my $line (reverse split "\n", $ps_out) {
if (substr($line,-4) eq 'bash') {
my $pid=$line;print "LINE=".__LINE__."\n";
($pid=$line)=~s/^(\d+) .*$/$1/;print "LINE=".__LINE__."\n";
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$pid,$kill_arg);print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
} else {
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$localhost->{_sh_pid},$kill_arg)
if exists $Net::FullAuto::FA_Core::localhost->{_sh_pid}
&& &Net::FullAuto::FA_Core::testpid(
$localhost->{_sh_pid});print "LINE=".__LINE__."\n";
}
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$localhost->{_cmd_pid},$kill_arg)
if &Net::FullAuto::FA_Core::testpid(
$localhost->{_cmd_pid});print "LINE=".__LINE__."\n";
$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 "
.($!);print "LINE=".__LINE__."\n";
warn $warn if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
print $MRLOG $warn
if $log && -1<index $MRLOG,'*';print "LINE=".__LINE__."\n";
sleep int $fatimeout/3;$retrys++;next;print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
my $pspath=$Net::FullAuto::FA_Core::gbp->('ps');print "LINE=".__LINE__."\n";
my $psoutput=`${pspath}ps`;print "LINE=".__LINE__."\n";
#print $Net::FullAuto::FA_Core::MRLOG "PSOUTPUTTTTTTTTTTTT=$psoutput<==\n";print "LINE=".__LINE__."\n";
$retrys++;print "LINE=".__LINE__."\n";
if (-1<index $login_Mast_error,'read') {
next;print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\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;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::dcipher='';print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
if ($retrys==3) {
$su_scrub=&scrub_passwd_file(
$hostlabel,$login_id);print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
if ($retrys==3) {
$su_scrub=&scrub_passwd_file(
$hostlabel,$login_id);print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
#print $MRLOG $login_Mast_error
# if $log && -1<index $MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$login_Mast_error,'__cleanup__');print "LINE=".__LINE__."\n";
} elsif ($su_id &&
-1<index($login_Mast_error,'ation is d')) {
$su_scrub=&scrub_passwd_file($hostlabel,$su_id);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} elsif (defined $Net::FullAuto::FA_Core::dcipher &&
$Net::FullAuto::FA_Core::dcipher) {
#print "DOING PASSWD UPDATE\n";print "LINE=".__LINE__."\n";
&passwd_db_update($hostlabel,$login_id,$password,
$cmd_type,$sshport);print "LINE=".__LINE__."\n";
}
}
my $c_t=$cmd_type;$c_t=~s/^(.)/uc($1)/e;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
print $MRLOG $die
if $log && -1<index $MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
} last;print "LINE=".__LINE__."\n";
}
if (defined $plan_ignore_error && !$plan_ignore_error) {
$Net::FullAuto::FA_Core::makeplan=&plan();print "LINE=".__LINE__."\n";
cleanup() if $Net::FullAuto::FA_Core::makeplan eq ']quit[';print "LINE=".__LINE__."\n";
} elsif (defined $plan && !$plan) {
$Net::FullAuto::FA_Core::makeplan=&plan();print "LINE=".__LINE__."\n";
cleanup() if $Net::FullAuto::FA_Core::makeplan eq ']quit[';print "LINE=".__LINE__."\n";
} elsif ($plan || $plan_ignore_error) {
$plan||=$plan_ignore_error||='';print "LINE=".__LINE__."\n";
my $plan_num=$plan;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
my $pref='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($plan_num,$pref);print "LINE=".__LINE__."\n";
$pref=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$plan=eval $pref;print "LINE=".__LINE__."\n";
if (exists $plan->{Expires} && $plan->{Expires} ne 'never'
&& $plan->{Expires}<time()) {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
localtime($plan->{Expires});print "LINE=".__LINE__."\n";
my $m=$month[$mon];$m=~s/\s*$//;print "LINE=".__LINE__."\n";
$year += 1900;print "LINE=".__LINE__."\n";
my $x="Expired => $days{$wday} $m $mday, $year ".
&Net::FullAuto::FA_Core::get_now_am_pm($plan->{Expires})." ".
POSIX::strftime("%Z",localtime($plan->{Expires}))."\n";print "LINE=".__LINE__."\n";
my $die="\n FATAL ERROR! - Plan $plan_num is --EXPIRED--\n".
"\n Plan $plan_num $x".
"\n Run fa --plan to alter Plan Settings.\n";print "LINE=".__LINE__."\n";
print $die if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
print $MRLOG $die
if $log && -1<index $MRLOG,'*';print "LINE=".__LINE__."\n";
cleanup();print "LINE=".__LINE__."\n";
}
$plan=$plan->{Plan};print "LINE=".__LINE__."\n";
}
return $cust_subnam_in_fa_code_module_file, \@menu_args, $fatimeout, $cache;print "LINE=".__LINE__."\n";
} ## END of &fa_login
sub fa_set {
my $vlin=__LINE__;print "LINE=".__LINE__."\n";
#####################################################################
#### ###
#### DEFAULT MODULE OF Net::FullAuto $fa_code IS: ###
#### ###
#### ==> Distro/fa_code_demo.pm <== If you want a different ###
#### ###
#### module to be the default, change $fa_code variable below or ###
#### set the $fa_code variable in the BEGIN { } block ###
#### of the top level script invoking Net::FullAuto. (Advised) ###
#### ###
#####################################################################
###
our $fa_code=['Distro/fa_code_demo.pm', #<== Change Location Here ###
"From $INC{'Net/FullAuto/FA_Core.pm'}, Line: ". ###
($vlin+15)]; ###
###
#####################################################################
#####################################################################
#### ###
#### DEFAULT MODULE OF Net::FullAuto $fa_conf IS: ###
#### ###
#### ==> Distro/fa_conf.pm <== If you want a differnet ###
#### ###
#### module to be the default, change $fa_conf variable below or ###
#### set the $fa_conf variable in the BEGIN { } block ###
#### of the top level script invoking Net::FullAuto. (Advised) ###
#### ###
#####################################################################
###
our $fa_conf=['Distro/fa_conf.pm', #<== Change Location Here ###
"From $INC{'Net/FullAuto/FA_Core.pm'}, Line: ". ###
($vlin+33)]; ###
###
#####################################################################
#####################################################################
#### ###
#### DEFAULT MODULE OF Net::FullAuto $fa_host IS: ###
#### ###
#### ==> Distro/fa_host.pm <== If you want a different ###
#### ###
#### module to be the default, change $fa_host variable below or ###
#### set the $fa_hosts_config variable in the BEGIN { } block ###
#### of the top level script invoking Net::FullAuto. (Advised) ###
#### ###
#####################################################################
###
our $fa_host=['Distro/fa_host.pm', #<== Change Location Here ###
"From $INC{'Net/FullAuto/FA_Core.pm'}, Line: ". ###
($vlin+51)]; ###
###
#####################################################################
#####################################################################
#### ###
#### DEFAULT MODULE OF Net::FullAuto $fa_maps IS: ###
#### ###
#### ==> Distro/fa_maps.pm <== If you want a different ###
#### ###
#### module to be the default, change $fa_host variable below or ###
#### set the $fa_mapping variable in the BEGIN { } block ###
#### of the top level script invoking Net::FullAuto. (Advised) ###
#### ###
#####################################################################
###
our $fa_maps=['Distro/fa_maps.pm', #<== Change Location Here ###
"From $INC{'Net/FullAuto/FA_Core.pm'}, Line: ". ###
($vlin+69)]; ###
###
#####################################################################
#####################################################################
#### ###
#### DEFAULT MODULE OF Net::FullAuto $fa_menu IS: ###
#### ###
#### ==> Distro/fa_menu_demo.pm <== If you want a different ###
#### ###
#### module to be the default, change $fa_menu variable below or ###
#### set the $fa_menu variable in the BEGIN { } block ###
#### of the top level script invoking Net::FullAuto. (Advised) ###
#### ###
#####################################################################
###
our $fa_menu=['Distro/fa_menu_demo.pm', #<== Change Location Here ###
"From $INC{'Net/FullAuto/FA_Core.pm'}, Line: ". ###
($vlin+87)]; ###
###
#####################################################################
unless (exists $INC{'Net/FullAuto.pm'}) {
foreach my $fpath (@INC) {
my $f=$fpath;print "LINE=".__LINE__."\n";
if (-e $f.'/Net/FullAuto.pm') {
$INC{'Net/FullAuto.pm'}=$f.'/Net/FullAuto.pm';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
}
my $fa_path=$INC{'Net/FullAuto.pm'};print "LINE=".__LINE__."\n";
substr($fa_path,-3)='';print "LINE=".__LINE__."\n";
chomp($fa_path);print "LINE=".__LINE__."\n";
my $net_path=$fa_path;print "LINE=".__LINE__."\n";
$net_path=~s/Net\/.*$//;print "LINE=".__LINE__."\n";
my %fullpath_files=();print "LINE=".__LINE__."\n";
my $default_modules='';print "LINE=".__LINE__."\n";
unless ($main::fa_code && $main::fa_conf && $main::fa_host
&& $main::fa_maps && $main::fa_menu) {
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
if (-f $fa_path.'/fa_global.pm') {
if (-r $fa_path.'/fa_global.pm') {
{
no strict 'subs';print "LINE=".__LINE__."\n";
require $fa_path.'/fa_global.pm';print "LINE=".__LINE__."\n";
$fa_global::FA_Secure||='';print "LINE=".__LINE__."\n";
if ($fa_global::FA_Secure &&
-d $fa_global::FA_Secure.'Defaults') {
BEGIN { $Term::Menus::facall=caller(2);print "LINE=".__LINE__."\n";
$Term::Menus::facall||='' };print "LINE=".__LINE__."\n";
use if (-1<index $Term::Menus::facall,'FullAuto'),
"BerkeleyDB";print "LINE=".__LINE__."\n";
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Defaults',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_defaults.db:".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
my $username=getlogin || getpwuid($<);print "LINE=".__LINE__."\n";
if (exists $ENV{'SSH_CONNECTION'} &&
exists $ENV{'USER'} && ($ENV{'USER'}
ne $username)) {
$username=$ENV{'USER'};print "LINE=".__LINE__."\n";
} elsif ($username eq 'SYSTEM' &&
exists $ENV{'IWUSER'} && ($ENV{'IWUSER'}
ne $username)) {
my $login_flag=0;print "LINE=".__LINE__."\n";
foreach (@ARGV) {
my $argv=$_;print "LINE=".__LINE__."\n";
if ($login_flag) {
$username=$argv;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif (lc($argv) eq '--login') {
$login_flag=1;print "LINE=".__LINE__."\n";
}
}
$username=$ENV{'IWUSER'} unless $login_flag;print "LINE=".__LINE__."\n";
}
my $status=$bdb->db_get(
$username,$default_modules) if $bdb;print "LINE=".__LINE__."\n";
$default_modules||='';print "LINE=".__LINE__."\n";
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';print "LINE=".__LINE__."\n";
$default_modules=eval $default_modules;print "LINE=".__LINE__."\n";
$default_modules||={};print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
unless (keys %{$default_modules}) {
$default_modules->{'set'}='none';print "LINE=".__LINE__."\n";
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_maps'}=
'Net/FullAuto/Distro/fa_maps.pm';print "LINE=".__LINE__."\n";
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';print "LINE=".__LINE__."\n";
} elsif (exists $default_modules->{'set'} &&
$default_modules->{'set'} ne 'none') {
my $setname=$default_modules->{'set'};print "LINE=".__LINE__."\n";
my $stenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');print "LINE=".__LINE__."\n";
my $std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $stenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
$std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $stenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_sets.db:".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $set='';print "LINE=".__LINE__."\n";
my $status=$std->db_get(
$username,$set);print "LINE=".__LINE__."\n";
$set||='';print "LINE=".__LINE__."\n";
$set=~s/\$HASH\d*\s*=\s*//s
if -1<index $set,'$HASH';print "LINE=".__LINE__."\n";
$set=eval $set;print "LINE=".__LINE__."\n";
$set||={};print "LINE=".__LINE__."\n";
undef $std;print "LINE=".__LINE__."\n";
$stenv->close();print "LINE=".__LINE__."\n";
undef $stenv;print "LINE=".__LINE__."\n";
$fa_code=[$set->{$setname}->{'fa_code'},
"From Default Set $setname ".
"(Change with fa --set)"];print "LINE=".__LINE__."\n";
$fa_conf=[$set->{$setname}->{'fa_conf'},
"From Default Set $setname ".
"(Change with fa --set)"];print "LINE=".__LINE__."\n";
$fa_host=[$set->{$setname}->{'fa_host'},
"From Default Set $setname ".
"(Change with fa --set)"];print "LINE=".__LINE__."\n";
$fa_maps=[$set->{$setname}->{'fa_maps'},
"From Default Set $setname ".
"(Change with fa --set)" ];print "LINE=".__LINE__."\n";
$fa_menu=[$set->{$setname}->{'fa_menu'},
"From Default Set $setname ".
"(Change with fa --set)"];print "LINE=".__LINE__."\n";
} else {
if (exists $default_modules->{'fa_code'}) {
$fa_code=[$default_modules->{'fa_code'},
"From Default Setting ".
"(Change with fa --defaults)"];print "LINE=".__LINE__."\n";
}
if (exists $default_modules->{'fa_conf'}) {
$fa_conf=[$default_modules->{'fa_conf'},
"From Default Setting ".
"(Change with fa --defaults)"];print "LINE=".__LINE__."\n";
}
if (exists $default_modules->{'fa_host'}) {
$fa_host=[$default_modules->{'fa_host'},
"From Default Setting ".
"(Change with fa --defaults)"];print "LINE=".__LINE__."\n";
}
if (exists $default_modules->{'fa_maps'}) {
$fa_maps=[$default_modules->{'fa_maps'},
"From Default Setting ".
"(Change with fa --defaults)"];print "LINE=".__LINE__."\n";
}
if (exists $default_modules->{'fa_menu'}) {
$fa_menu=[$default_modules->{'fa_menu'},
"From Default Setting ".
"(Change with fa --defaults)"];print "LINE=".__LINE__."\n";
}
}
}
}
} else {
warn("WARNING: Cannot read defaults file $fa_path/fa_global.pm".
" - permission denied (Hint: Perhaps you need to 'Run as ".
"Administrator'?)");print "LINE=".__LINE__."\n";
}
}
my @A=();my %A=();print "LINE=".__LINE__."\n";
push @A,@ARGV;print "LINE=".__LINE__."\n";
my $acnt=0;print "LINE=".__LINE__."\n";
foreach my $a (@A) {
$acnt++;print "LINE=".__LINE__."\n";
my $aa=$a;print "LINE=".__LINE__."\n";
if (-1<index $aa,'--fa_') {
my $k=unpack('x5a*',$aa);print "LINE=".__LINE__."\n";
my $v=$A[$acnt]||'';print "LINE=".__LINE__."\n";
unless (-1<index $v, '--fa_') {
$A{$k}=$v;print "LINE=".__LINE__."\n";
} else {
@A=();print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} elsif (-1<index $aa,'--set') {
my $v=$A[$acnt]||'';print "LINE=".__LINE__."\n";
unless (-1<index $v, '--') {
$A{set}=$v;print "LINE=".__LINE__."\n";
} else {
@A=();print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
}
foreach my $e (('set','code','conf','host','maps','menu')) {
if (exists $A{$e}) {
if ($e eq 'set') {
no strict 'subs';print "LINE=".__LINE__."\n";
my $setname=$A{$e};print "LINE=".__LINE__."\n";
my $progname=substr($0,(rindex $0,'/')+1,-3);print "LINE=".__LINE__."\n";
if (-f $fa_path.'/fa_global.pm') {
my $stenv = BerkeleyDB::Env->new(
-Home => $fa_global::FA_Secure.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');print "LINE=".__LINE__."\n";
my $std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $stenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
$std = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $stenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB ${progname}_sets.db:".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $set='';print "LINE=".__LINE__."\n";
my $status=$std->db_get(
$username,$set);print "LINE=".__LINE__."\n";
$set||='';print "LINE=".__LINE__."\n";
$set=~s/\$HASH\d*\s*=\s*//s
if -1<index $set,'$HASH';print "LINE=".__LINE__."\n";
$set=eval $set;print "LINE=".__LINE__."\n";
$set||={};print "LINE=".__LINE__."\n";
undef $std;print "LINE=".__LINE__."\n";
$stenv->close();print "LINE=".__LINE__."\n";
undef $stenv;print "LINE=".__LINE__."\n";
$fa_code=[$set->{$setname}->{'fa_code'},
"From CMD arg fa --set $setname line ".__LINE__];print "LINE=".__LINE__."\n";
$fa_conf=[$set->{$setname}->{'fa_conf'},
"From CMD arg fa --set $setname line ".__LINE__];print "LINE=".__LINE__."\n";
$fa_host=[$set->{$setname}->{'fa_host'},
"From CMD arg fa --set $setname line ".__LINE__];print "LINE=".__LINE__."\n";
$fa_maps=[$set->{$setname}->{'fa_maps'},
"From CMD arg fa --set $setname line ".__LINE__];print "LINE=".__LINE__."\n";
$fa_menu=[$set->{$setname}->{'fa_menu'},
"From CMD arg fa --set $setname line ".__LINE__];print "LINE=".__LINE__."\n";
} else {
my $die="\n FATAL ERROR: The Set indicated from".
" the CMD arg:\n\n".
" ==> fa --set $A{$e}n\n".
" does not exist. To create this\n".
" set, run fa --set without any\n".
" other arguments";print "LINE=".__LINE__."\n";
die $die;print "LINE=".__LINE__."\n";
}
} elsif ($e eq 'code') {
$fa_code=$A{$e};print "LINE=".__LINE__."\n";
$fa_code=[$fa_code,
"From CMD arg: fa --fa_code $A{$e}"];print "LINE=".__LINE__."\n";
} elsif ($e eq 'menu') {
$fa_menu=$A{$e};print "LINE=".__LINE__."\n";
$fa_menu=[$fa_menu,
"From CMD arg: fa --fa_menu $A{$e}"];print "LINE=".__LINE__."\n";
} elsif ($e eq 'host') {
$fa_host=$A{$e};print "LINE=".__LINE__."\n";
$fa_host=[$fa_host,
"From CMD arg: fa --fa_host $A{$e}"];print "LINE=".__LINE__."\n";
} elsif ($e eq 'conf') {
$fa_conf=$A{$e};print "LINE=".__LINE__."\n";
$fa_conf=[$fa_conf,
"From CMD arg: fa --fa_conf $A{$e}"];print "LINE=".__LINE__."\n";
} elsif ($e eq 'maps') {
$fa_maps=$A{$e};print "LINE=".__LINE__."\n";
$fa_maps=[$fa_maps,
"From CMD arg: fa --fa_maps $A{$e}"];print "LINE=".__LINE__."\n";
}
}
my $abspath=Cwd::abs_path($0);print "LINE=".__LINE__."\n";
$abspath=~s/\.exe$//;print "LINE=".__LINE__."\n";
$abspath.='.pl';print "LINE=".__LINE__."\n";
if (defined $main::fa_code && $main::fa_code) {
$fa_code=$main::fa_code;print "LINE=".__LINE__."\n";
my $p=Cwd::abs_path($0);print "LINE=".__LINE__."\n";
$fa_code=[$fa_code,
"From \$fa_code variable in $abspath"];print "LINE=".__LINE__."\n";
}
if (defined $main::fa_conf && $main::fa_conf) {
$fa_conf=$main::fa_conf;print "LINE=".__LINE__."\n";
$fa_conf=[$fa_conf,
"From \$fa_conf variable in $abspath"];print "LINE=".__LINE__."\n";
}
if (defined $main::fa_host && $main::fa_host) {
$fa_host=$main::fa_host;print "LINE=".__LINE__."\n";
$fa_host=[$fa_host,
"From \$fa_host variable in $abspath"];print "LINE=".__LINE__."\n";
}
if (defined $main::fa_maps && $main::fa_maps) {
$fa_maps=$main::fa_maps;print "LINE=".__LINE__."\n";
$fa_maps=[$fa_maps,
"From \$fa_maps variable in $abspath"];print "LINE=".__LINE__."\n";
}
if (defined $main::fa_menu && $main::fa_menu) {
$fa_menu=$main::fa_menu;print "LINE=".__LINE__."\n";
$fa_menu=[$fa_menu,
"From \$fa_menu variable in $abspath"];print "LINE=".__LINE__."\n";
}
}
} else {
my $abspath=Cwd::abs_path($0);print "LINE=".__LINE__."\n";
$abspath=~s/\.exe$//;print "LINE=".__LINE__."\n";
$abspath.='.pl';print "LINE=".__LINE__."\n";
$fa_code=[$fa_code,
"From \$fa_code variable in $abspath"];print "LINE=".__LINE__."\n";
$fa_conf=[$fa_conf,
"From \$fa_conf variable in $abspath"];print "LINE=".__LINE__."\n";
$fa_host=[$fa_host,
"From \$fa_host variable in $abspath"];print "LINE=".__LINE__."\n";
$fa_maps=[$fa_maps,
"From \$fa_maps variable in $abspath"];print "LINE=".__LINE__."\n";
$fa_menu=[$fa_menu,
"From \$fa_menu variable in $abspath"];print "LINE=".__LINE__."\n";
}
$fa_code->[0]='Net/FullAuto/'.$fa_code->[0]
if $fa_code->[0] && -1==index $fa_code->[0],'Net/FullAuto';print "LINE=".__LINE__."\n";
$fa_code->[0]||='';print "LINE=".__LINE__."\n";
$fullpath_files{'code'}=$net_path.$fa_code->[0] if $fa_code->[0];print "LINE=".__LINE__."\n";
$fullpath_files{'code'}||='';print "LINE=".__LINE__."\n";
my $argv=join " ",@ARGV;print "LINE=".__LINE__."\n";
if ($argv!~/--edi*t* *|-e[a-z]|--admin|-V|-v|--VE*R*S*I*O*N*/) {
if ($fa_code->[0]) {
if ($Term::Menus::canload->($fa_code->[0])) {
require $fa_code->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_code->[0],(rindex $fa_code->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fullpath_files{'code'}=$net_path.$fa_code->[0];print "LINE=".__LINE__."\n";
$fa_code=$mod.'.pm';print "LINE=".__LINE__."\n";
} else {
my $ln=__LINE__;print "LINE=".__LINE__."\n";
$ln-=5;print "LINE=".__LINE__."\n";
die "Cannot load module $fa_code->[0]".
"\n $fa_code->[1]\n".
"\"require $fa_code->[0];\"".
"--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n";print "LINE=".__LINE__."\n";
}
} else {
require 'Net/FullAuto/Distro/fa_code.pm';print "LINE=".__LINE__."\n";
import fa_code;print "LINE=".__LINE__."\n";
$fullpath_files{'code'}=$net_path.'Net/FullAuto/Distro/fa_code.pm';print "LINE=".__LINE__."\n";
$fa_code='fa_code.pm';print "LINE=".__LINE__."\n";
}
}
$fa_conf->[0]='Net/FullAuto/'.$fa_conf->[0]
if $fa_conf->[0] && -1==index $fa_conf->[0],'Net/FullAuto';print "LINE=".__LINE__."\n";
$fa_conf->[0]||='';print "LINE=".__LINE__."\n";
$fullpath_files{'conf'}=$net_path.$fa_conf->[0] if $fa_conf->[0];print "LINE=".__LINE__."\n";
$fullpath_files{'conf'}||='';print "LINE=".__LINE__."\n";
if ($argv!~/--edi*t* *|-e[a-z]|--admin|-V|-v|--VE*R*S*I*O*N*/) {
if ($fa_conf->[0]) {
if ($Term::Menus::canload->($fa_conf->[0])) {
require $fa_conf->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fullpath_files{'conf'}=$net_path.$fa_conf->[0];print "LINE=".__LINE__."\n";
$fa_conf=$mod.'.pm';print "LINE=".__LINE__."\n";
} else {
my $ln=__LINE__;print "LINE=".__LINE__."\n";
$ln-=5;print "LINE=".__LINE__."\n";
die "Cannot load module $fa_conf->[0]".
"\n $fa_conf->[1]\n".
"\"require $fa_conf->[0];\"".
"--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n";print "LINE=".__LINE__."\n";
}
} else {
require 'Net/FullAuto/Distro/fa_conf.pm';print "LINE=".__LINE__."\n";
import fa_conf;print "LINE=".__LINE__."\n";
$fullpath_files{'conf'}=$net_path.'Net/FullAuto/Distro/fa_conf.pm';print "LINE=".__LINE__."\n";
$fa_conf='fa_conf.pm';print "LINE=".__LINE__."\n";
}
}
$fa_host->[0]='Net/FullAuto/'.$fa_host->[0]
if $fa_host->[0] && -1==index $fa_host->[0],'Net/FullAuto';print "LINE=".__LINE__."\n";
$fa_host->[0]||='';print "LINE=".__LINE__."\n";
$fullpath_files{'host'}=$net_path.$fa_host->[0] if $fa_host->[0];print "LINE=".__LINE__."\n";
$fullpath_files{'host'}||='';print "LINE=".__LINE__."\n";
if ($argv!~/--edi*t* *|-e[a-z]|--admin|-V|-v|--VE*R*S*I*O*N*/) {
if ($fa_host->[0]) {
if ($Term::Menus::canload->($fa_host->[0])) {
require $fa_host->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_host->[0],(rindex $fa_host->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fullpath_files{'host'}=$net_path.$fa_host->[0];print "LINE=".__LINE__."\n";
$fa_host=$mod.'.pm';print "LINE=".__LINE__."\n";
} else {
my $ln=__LINE__;print "LINE=".__LINE__."\n";
$ln-=5;print "LINE=".__LINE__."\n";
die "Cannot load module $fa_host->[0]".
"\n $fa_host->[1]\n".
"\"require $fa_host->[0];\"".
"--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n";print "LINE=".__LINE__."\n";
}
} else {
require 'Net/FullAuto/Distro/fa_host.pm';print "LINE=".__LINE__."\n";
import fa_host;print "LINE=".__LINE__."\n";
$fullpath_files{'host'}=$net_path.'Net/FullAuto/Distro/fa_host.pm';print "LINE=".__LINE__."\n";
$fa_host='fa_host.pm';print "LINE=".__LINE__."\n";
}
}
$fa_maps->[0]='Net/FullAuto/'.$fa_maps->[0]
if $fa_maps->[0] && -1==index $fa_maps->[0],'Net/FullAuto';print "LINE=".__LINE__."\n";
$fa_maps->[0]||='';print "LINE=".__LINE__."\n";
$fullpath_files{'maps'}=$net_path.$fa_maps->[0] if $fa_maps->[0];print "LINE=".__LINE__."\n";
$fullpath_files{'maps'}||='';print "LINE=".__LINE__."\n";
if ($argv!~/--edi*t* *|-e[a-z]|--admin|-V|-v|--VE*R*S*I*O*N*/) {
if ($fa_maps->[0]) {
if ($Term::Menus::canload->($fa_maps->[0])) {
require $fa_maps->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_maps->[0],(rindex $fa_maps->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fullpath_files{'maps'}=$net_path.$fa_maps->[0];print "LINE=".__LINE__."\n";
$fa_maps=$mod.'.pm';print "LINE=".__LINE__."\n";
} else {
my $ln=__LINE__;print "LINE=".__LINE__."\n";
$ln-=5;print "LINE=".__LINE__."\n";
die "Cannot load module $fa_maps->[0]".
"\n $fa_maps->[1]\n".
"\"require $fa_maps->[0];\"".
"--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n";print "LINE=".__LINE__."\n";
}
} else {
require 'Net/FullAuto/Distro/fa_maps.pm';print "LINE=".__LINE__."\n";
import fa_maps;print "LINE=".__LINE__."\n";
$fullpath_files{'maps'}=$net_path.'Net/FullAuto/Distro/fa_maps.pm';print "LINE=".__LINE__."\n";
$fa_maps='fa_maps.pm';print "LINE=".__LINE__."\n";
}
}
$fa_menu->[0]='Net/FullAuto/'.$fa_menu->[0]
if $fa_menu->[0] && -1==index $fa_menu->[0],'Net/FullAuto';print "LINE=".__LINE__."\n";
$fa_menu->[0]||='';print "LINE=".__LINE__."\n";
$fullpath_files{'menu'}=$net_path.$fa_menu->[0] if $fa_menu->[0];print "LINE=".__LINE__."\n";
$fullpath_files{'menu'}||='';print "LINE=".__LINE__."\n";
if ($argv!~/--edi*t* *|-e[a-z]|--admin|-V|-v|--VE*R*S*I*O*N*/) {
if ($fa_menu->[0]) {
if ($Term::Menus::canload->($fa_menu->[0])) {
require $fa_menu->[0];print "LINE=".__LINE__."\n";
my $mod=substr($fa_menu->[0],(rindex $fa_menu->[0],'/')+1,-3);print "LINE=".__LINE__."\n";
import $mod;print "LINE=".__LINE__."\n";
$fullpath_files{'menu'}=$net_path.$fa_menu->[0];print "LINE=".__LINE__."\n";
$fa_menu=$mod.'.pm';print "LINE=".__LINE__."\n";
} else {
my $ln=__LINE__;print "LINE=".__LINE__."\n";
$ln-=5;print "LINE=".__LINE__."\n";
die "Cannot load module $fa_menu->[0]".
"\n $fa_menu->[1]\n".
"\"require $fa_menu->[0];\"".
"--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n";print "LINE=".__LINE__."\n";
}
} else {
require 'Net/FullAuto/Distro/fa_menu_demo.pm';print "LINE=".__LINE__."\n";
import fa_menu_demo;print "LINE=".__LINE__."\n";
$fullpath_files{'menu'}=$net_path.'Net/FullAuto/Distro/fa_menu_demo.pm';print "LINE=".__LINE__."\n";
$fa_menu='fa_menu_demo.pm';print "LINE=".__LINE__."\n";
}
}
return \%fullpath_files;print "LINE=".__LINE__."\n";
}
our $adminmenu=sub {
my $invoke_menu_here=0;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::skip_host_hash||=0;print "LINE=".__LINE__."\n";
if ((-1==index $Net::FullAuto::FA_Core::localhost,'=')
&& ($Net::FullAuto::FA_Core::skip_host_hash==0)) {
$invoke_menu_here=1;print "LINE=".__LINE__."\n";
can_load(modules => { "Term::Menus" => 0 });print "LINE=".__LINE__."\n";
can_load(modules => { "Net::FullAuto" => 0 });print "LINE=".__LINE__."\n";
my @Hosts=@{&check_Hosts($Net::FullAuto::FA_Core::fa_host)};print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::host_hash(\@Hosts);print "LINE=".__LINE__."\n";
}
my $fam=<<FAM;print "LINE=".__LINE__."\n";
_ _ _ __ __
/_\\ __| |_ __ (_)_ _ | \\/ |___ _ _ _ _
/ _ \\/ _` | ' \\| | ' \\ | |\\/| / -_) ' \\ || |
/_/ \\_\\__,_|_|_|_|_|_||_| |_| |_\\___|_||_\\_,_|
FAM
my %admin=(
Item_1 => {
Text => 'FullAuto *PLAN + JOB* Menu',
Result => $plan_menu_sub,
},
Item_2 => {
Text => 'FullAuto *DEFAULT* Settings Menu',
Result => $admin_defaults_sub->(),
},
Item_3 => {
Text => 'FullAuto *SET* Configuration Menu',
Result => $set_menu_sub->(),
},
Item_4 => {
Text => 'FullAuto *IMPORT/EXPORT* Menu',
Result => $im_ex_menu_sub,
},
Banner => $fam,
);print "LINE=".__LINE__."\n";
unless ($invoke_menu_here) {
return \%admin;print "LINE=".__LINE__."\n";
} else {
my @menu_output=();print "LINE=".__LINE__."\n";
while (1) {
@menu_output=Menu(\%admin);print "LINE=".__LINE__."\n";
last if ($menu_output[0] ne '-' && $menu_output[0] ne '+');print "LINE=".__LINE__."\n";
}
if ( grep { /\]quit\[/ } @menu_output) {
&Net::FullAuto::FA_Core::release_fa_lock(9361);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::cleanup();print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
our $admin_menu=sub {
return $adminmenu->();print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
our $choose_pass_expiration=sub {
my $selection=&Menu(\%ask_exp);print "LINE=".__LINE__."\n";
#print "SELECTION=$selection\n";print "LINE=".__LINE__."\n";
&cleanup if $selection eq ']quit[';print "LINE=".__LINE__."\n";
return $selection;print "LINE=".__LINE__."\n";
if (0) {
my ($num,$type)=('','');print "LINE=".__LINE__."\n";
($num,$type)=split /\s+/, $selection;print "LINE=".__LINE__."\n";
if ($num!~/^\d/) {
my @d=split /,* +/, $selection;print "LINE=".__LINE__."\n";
$mn=unpack('a3',$d[0]);print "LINE=".__LINE__."\n";
#print "MN=$mn and D=$d[0]\n";print "LINE=".__LINE__."\n";
if (defined $d[3] && $d[3]) {
my $ap=substr($d[3],-2);print "LINE=".__LINE__."\n";
my ($h,$m)=('','');print "LINE=".__LINE__."\n";
($h,$m)=split ':',substr($d[3],0,-2);print "LINE=".__LINE__."\n";
$h+=12 if $ap eq 'pm' && $h!=12;print "LINE=".__LINE__."\n";
return &Net::FullAuto::FA_Core::timelocal(
0,$m,$h,$d[1],$Net::FullAuto::FA_Core::month{$mn}-1,$d[2]);print "LINE=".__LINE__."\n";
}
return &Net::FullAuto::FA_Core::timelocal(
0,0,0,$d[1],$Net::FullAuto::FA_Core::month{$mn}-1,$d[2]);print "LINE=".__LINE__."\n";
} elsif ($type=~/Min/) {
return time + $num * 60;print "LINE=".__LINE__."\n";
} elsif ($type=~/Hour/) {
return time + $num * 3600;print "LINE=".__LINE__."\n";
} elsif ($type=~/Day/) {
return time + $num * 86400;print "LINE=".__LINE__."\n";
} elsif ($type=~/Week/) {
return time + $num * 604800;
} elsif ($type=~/Month/) {
return time + $num * 2592000;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
sub passwd_db_update
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "main::passwd_db_update() CALLER="
,(join ' ',@topcaller),"\n";# if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "main::passwd_db_update() CALLER=",
(join ' ',@topcaller),"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $hostlabel=$_[0];my $login_id=$_[1];my $passwd=$_[2];print "LINE=".__LINE__."\n";
my $cmd_type=$_[3];my $sshport=$_[4]||'';print "LINE=".__LINE__."\n";
my $kind='prod';print "LINE=".__LINE__."\n";
my $local_host_flag=0;print "LINE=".__LINE__."\n";
my $track='';print "LINE=".__LINE__."\n";
$kind='test' if
$Net::FullAuto::FA_Core::test && !$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
if ($hostlabel eq "__Master_${$}__") {
# print the contents of the file
my ($k,$v) = ("","") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
next if $k eq "__Master_${$}__";print "LINE=".__LINE__."\n";
$hostlabel=$k;print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
undef $cursor ;print "LINE=".__LINE__."\n";
if (!$local_host_flag) {
$hostlabel=$Net::FullAuto::FA_Core::local_hostname;print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
} elsif (exists
$Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel}
&& !$sshport) {
$local_host_flag=1;print "LINE=".__LINE__."\n";
} my $key='';print "LINE=".__LINE__."\n";
if ($local_host_flag) {
$key="${username}_X_"
."${hostlabel}_X_${$}_X_$Net::FullAuto::FA_Core::invoked[0]";print "LINE=".__LINE__."\n";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_"
."${hostlabel}_X_$cmd_type";print "LINE=".__LINE__."\n";
} else {
$key="${username}_X_${login_id}_X_"
.$hostlabel;print "LINE=".__LINE__."\n";
}
my $href='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($hostlabel,$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
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_".$$."__";print "LINE=".__LINE__."\n";
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'});print "LINE=".__LINE__."\n";
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
#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'});print "LINE=".__LINE__."\n";
print "WHAT IS THE DANGGGG PASSWD=$passwd<==\n";<STDIN>;print "LINE=".__LINE__."\n";
my $new_encrypted=$cipher->encrypt($passwd);print "LINE=".__LINE__."\n";
$href->{$key}=$new_encrypted;print "LINE=".__LINE__."\n";
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($hostlabel,$put_href);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
}
sub su_scrub
{
my $hostlabel=$_[0];my $login_id='';my $cmd_type=$_[1];print "LINE=".__LINE__."\n";
my $kind='prod';my $track='';print "LINE=".__LINE__."\n";
$kind='test' if
$Net::FullAuto::FA_Core::test && !$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "FA_SUCURE9=",
$Hosts{"__Master_${$}__"}{'FA_Secure'},"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $local_host_flag=0;print "LINE=".__LINE__."\n";
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %Net::FullAuto::FA_Core::same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
if (!$local_host_flag) {
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
} elsif (exists $Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel}) {
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
my $href='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($hostlabel,$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
my $key='';print "LINE=".__LINE__."\n";
if ($local_host_flag) {
$key="${username}_X_"
."${hostlabel}_X_${$}_X_$Net::FullAuto::FA_Core::invoked[0]";print "LINE=".__LINE__."\n";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_"
."${hostlabel}_X_$cmd_type";print "LINE=".__LINE__."\n";
} else {
$key="${username}_X_${login_id}_X_"
.$hostlabel;print "LINE=".__LINE__."\n";
}
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_".$$."__";print "LINE=".__LINE__."\n";
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'});print "LINE=".__LINE__."\n";
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
#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'});print "LINE=".__LINE__."\n";
#my $new_encrypted=$cipher->encrypt($Net::FullAuto::FA_Core::passwd[0]);print "LINE=".__LINE__."\n";
my $new_encrypted=$cipher->encrypt(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]));print "LINE=".__LINE__."\n";
#my $new_encrypted=$cipher->encrypt($Net::FullAuto::FA_Core::passetts->[0]);print "LINE=".__LINE__."\n";
$href->{$key}=$new_encrypted;print "LINE=".__LINE__."\n";
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($hostlabel,$put_href);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
}
sub su
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "su() CALLER=", (join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "su() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $fh=$_[0];print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $username=$_[2];print "LINE=".__LINE__."\n";
my $su_id=$_[3];print "LINE=".__LINE__."\n";
my $hostname=$_[4];print "LINE=".__LINE__."\n";
my $ip=$_[5];print "LINE=".__LINE__."\n";
my $use=$_[6];print "LINE=".__LINE__."\n";
my $uname=$_[7];print "LINE=".__LINE__."\n";
my $_connect=$_[8];print "LINE=".__LINE__."\n";
my $cmd_type=$_[9];print "LINE=".__LINE__."\n";
my @connect_method=@{$_[10]};print "LINE=".__LINE__."\n";
my $errmsg=$_[11];print "LINE=".__LINE__."\n";
my $pass_flag=0;print "LINE=".__LINE__."\n";
my $id='';my $stderr='';my $track='';print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
if ($su_id eq 'root') {
my $gids='';print "LINE=".__LINE__."\n";
#$fh->print('groups');print "LINE=".__LINE__."\n";
#while (my $line=$fh->get) {
# chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
# $gids.=$line;print "LINE=".__LINE__."\n";
#print $Net::FullAuto::FA_Core::MRLOG "su() GIDS=$gids<==\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
# last if $gids=~s/_funkyPrompt_//gs;print "LINE=".__LINE__."\n";
# }
# --CONTINUE-- print "GOING FOR GIDS\n";print "LINE=".__LINE__."\n";
my $ctt=2;print "LINE=".__LINE__."\n";
while ($ctt--) {
($gids,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ] },'groups');print "LINE=".__LINE__."\n";
if (!$gids && !$stderr) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$fh);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
} last if $gids;print "LINE=".__LINE__."\n";
}
die 'no-gids' if !$gids || $stderr;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "su() DONEGID=$gids<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
#$gids=unpack('x6 a*',$gids);print "LINE=".__LINE__."\n";
if (lc($uname) eq 'aix' && (-1==index $gids,'suroot')) {
my $hostlb=$hostlabel;print "LINE=".__LINE__."\n";
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";print "LINE=".__LINE__."\n";
$hostlb=$hostlab;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
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";print "LINE=".__LINE__."\n";
my $kind='prod';print "LINE=".__LINE__."\n";
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $href='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($hostlabel,$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
my $key="${username}_X_${su_id}_X_${hostlabel}";print "LINE=".__LINE__."\n";
while (delete $href->{$key}) {}
$status=$bdb->db_put($hostlabel,$href);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DYING HERE WITH LOCK PROB" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return '',"$die $!";print "LINE=".__LINE__."\n";
}
}
#if ($su_id eq 'root') {
$fh->print("su $su_id");print "LINE=".__LINE__."\n";
#} else {
# $fh->print("login $su_id");print "LINE=".__LINE__."\n";
#}
return '', $fh->errmsg if $fh->errmsg;print "LINE=".__LINE__."\n";
# Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect });print "LINE=".__LINE__."\n";
if ($stderr) {
return '',$stderr if $stderr;print "LINE=".__LINE__."\n";
}
## Send password.
$fh->print(&getpasswd(
$hostlabel,$su_id,'',
$errmsg,'__su__'));print "LINE=".__LINE__."\n";
$fh=&Rem_Command::wait_for_prompt(
$fh,$timeout,\@connect_method,$hostlabel,'__su__');print "LINE=".__LINE__."\n";
my $cnt=2;print "LINE=".__LINE__."\n";
while (1) {
($id,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ] },
'id -unr');print "LINE=".__LINE__."\n";
if ($id eq $su_id || $id eq 'root') {
last;print "LINE=".__LINE__."\n";
} elsif ($cnt--==0) {
die "Cannot discover user id at ".__LINE__;print "LINE=".__LINE__."\n";
}
}
#($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);print "LINE=".__LINE__."\n";
#&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
return '',$fh->errmsg if $fh->errmsg;print "LINE=".__LINE__."\n";
if ($id ne $su_id && $id ne 'root') {
$fh->print("su $su_id");print "LINE=".__LINE__."\n";
return '',$fh->errmsg if $fh->errmsg;print "LINE=".__LINE__."\n";
## Wait for password prompt.
while (my $line=$fh->get) {
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
if ($line=~/password[: ]*$/i) {
$pass_flag=1;last;print "LINE=".__LINE__."\n";
} elsif (!$Net::FullAuto::FA_Core::cron &&
$line=~/\[YOU HAVE NEW MAIL\]/m) {
my $hostlab=$hostlabel;print "LINE=".__LINE__."\n";
$hostlab=(keys %same_host_as_Master)[1]
if $hostlabel eq "__Master_${$}__";print "LINE=".__LINE__."\n";
print "\nAttn: $su_id on $hostlab --> [YOU HAVE NEW MAIL]\n\n";print "LINE=".__LINE__."\n";
sleep 1;print "LINE=".__LINE__."\n";
} last if $line=~/[$|%|>|#|-|:] ?$/m;
}
## Send password.
if ($pass_flag) {
$fh->print(&getpasswd(
$hostlabel,$su_id,'',$errmsg,
'__force__','__su__'));print "LINE=".__LINE__."\n";
}
($id,$stderr)=&unix_id($fh,$su_id,$hostlabel,$errmsg);print "LINE=".__LINE__."\n";
if (defined $stderr) {
return '',$stderr;print "LINE=".__LINE__."\n";
} elsif ($id ne $su_id) {
return '', "Cannot Login as Alternate User -> $su_id";print "LINE=".__LINE__."\n";
}
}
## Make sure prompt won't match anything in send data.
my $prompt = '_funkyPrompt_';print "LINE=".__LINE__."\n";
$fh->prompt("/$prompt\$/");print "LINE=".__LINE__."\n";
$fh->print("export PS1=$prompt;unset PROMPT_COMMAND");print "LINE=".__LINE__."\n";
while (my $line=$fh->get) {
last if $line=~/$prompt$/s;print "LINE=".__LINE__."\n";
}
}
sub change_pw {
my $cmd_handle=$_[0];print "LINE=".__LINE__."\n";
print $blanklines;print "LINE=".__LINE__."\n";
## Send new passwd.
ReadMode 2;print "LINE=".__LINE__."\n";
my $npw=<STDIN>;print "LINE=".__LINE__."\n";
ReadMode 0;print "LINE=".__LINE__."\n";
PW: while (1) {
chomp($npw);print "LINE=".__LINE__."\n";
$cmd_handle->print("$npw");print "LINE=".__LINE__."\n";
my ($output,$line)='';print "LINE=".__LINE__."\n";
while ($line=$_[0]->get) {
if ($line=~/changed/) {
print $blanklines;print "LINE=".__LINE__."\n";
last PW;print "LINE=".__LINE__."\n";
}
$output.=$line;print "LINE=".__LINE__."\n";
if ($line=~/: ?$/i) {
print $output;print "LINE=".__LINE__."\n";
ReadMode 2;print "LINE=".__LINE__."\n";
$npw=<STDIN>;print "LINE=".__LINE__."\n";
ReadMode 0;print "LINE=".__LINE__."\n";
$output='';print "LINE=".__LINE__."\n";
print $blanklines;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
}
}
sub unix_id {
#my $logreset=1;print "LINE=".__LINE__."\n";
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "unix_id() CALLER=", (join ' ',@topcaller),"\n";print "LINE=".__LINE__."\n";
#if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $localhost=$_[0];print "LINE=".__LINE__."\n";
my $su_id=$_[1];print "LINE=".__LINE__."\n";
my $hostlabel=$_[2];print "LINE=".__LINE__."\n";
my $die='';my $id='';print "LINE=".__LINE__."\n";
my $prompt='';my $dieline='';print "LINE=".__LINE__."\n";
eval {
my $next=0;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "GETMAILLINE=$line\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
next if $line=~/^\s+$/s;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron && $line=~/\[YOU/s) {
my $hostlab=$hostlabel;print "LINE=".__LINE__."\n";
$hostlab=(keys %same_host_as_Master)[1]
if $hostlabel eq "__Master_${$}__";print "LINE=".__LINE__."\n";
print "\nAttn: $su_id on $hostlab --> [YOU HAVE NEW MAIL]\n\n";print "LINE=".__LINE__."\n";
$localhost->print;print "LINE=".__LINE__."\n";
sleep 1;print "LINE=".__LINE__."\n";
} elsif ($line=~/\d\d\d\d-\d\d\d /s) {
$dieline=__LINE__;print "LINE=".__LINE__."\n";
$die.=$line;print "LINE=".__LINE__."\n";
$localhost->print;next;print "LINE=".__LINE__."\n";
} else { $localhost->print }
last
} $localhost->print;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "OUTOFGETMAIL\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print "OUTOFGETMAIL\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "GETPROMPTLINE=$line\n"; #if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
next if $line=~/^\s*$/s;print "LINE=".__LINE__."\n";
($prompt=$line)=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
$prompt=~s/^\^C//;print "LINE=".__LINE__."\n";
print "WHAT IS PROMPT=$prompt<===\n";print "LINE=".__LINE__."\n";
return if $prompt;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
my $cmd_prompt=quotemeta $prompt;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "PROMPT=$prompt<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print "PROMPT=$prompt<==\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
if ($die) {
$die=~s/$cmd_prompt$//s;print "LINE=".__LINE__."\n";
$die=~s/^/ /m;print "LINE=".__LINE__."\n";
$die=" $hostlabel Login ERROR! :\n$die";print "LINE=".__LINE__."\n";
$die.=" ".($!)." at Line $dieline";print "LINE=".__LINE__."\n";
}
if ($@) {
if ($die) {
return '',$die
} else {
return '',$@
}
}
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
eval {
$localhost->print('id -unr');print "LINE=".__LINE__."\n";
select(undef,undef,undef,0.02); # sleep for 1/50th second;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$line=~tr/\0-\11\13-\37\177-\377//d;print "LINE=".__LINE__."\n";
$id.=$line;print "LINE=".__LINE__."\n";
$id=~s/id -unr\s*//s;print "LINE=".__LINE__."\n";
next if $id!~s/\s*$cmd_prompt$//s;print "LINE=".__LINE__."\n";
$id=~s/^\s*//;print "LINE=".__LINE__."\n";
last
}
};print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
return $id,''
}
sub ping
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "ping() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ping() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $cmd='';my $stdout='';my $stderr='';my $didping=10;print "LINE=".__LINE__."\n";
if ($specialperms eq 'setuid') {
if ($^O eq 'cygwin') {
$cmd=[ $Net::FullAuto::FA_Core::gbp->('ping').
"ping",'-n','1',$_[0],"2>&1" ];print "LINE=".__LINE__."\n";
} else {
my $bashpath=$Net::FullAuto::FA_Core::gbp->('bash');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'bash'}) {
$bashpath=$Hosts{"__Master_${$}__"}{'bash'};print "LINE=".__LINE__."\n";
$bashpath.='/' if $bashpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $pth=$Hosts{"__Master_${$}__"}{'FA_Core'}."ping$$.sh";print "LINE=".__LINE__."\n";
open(TP,">$pth") || die "CANNOT OPEN $pth $!";print "LINE=".__LINE__."\n";
print TP $Net::FullAuto::FA_Core::gbp->('ping')."ping -c1 $_[0] 2>&1";
CORE::close(TP);print "LINE=".__LINE__."\n";
$cmd=[ "${bashpath}bash",$pth,"2>&1" ];print "LINE=".__LINE__."\n";
}
} else {
if ($^O eq 'cygwin') {
$cmd=[ $Net::FullAuto::FA_Core::gbp->('ping')."ping -n 1 $_[0]" ];print "LINE=".__LINE__."\n";
} else {
$cmd=[ $Net::FullAuto::FA_Core::gbp->('ping')."ping -c1 $_[0]" ];print "LINE=".__LINE__."\n";
}
}
eval {
unless ($specialperms eq 'setuid') {
($stdout,$stderr)=$localhost->cmd($cmd->[0],5);print "LINE=".__LINE__."\n";
} else {
$didping=7;print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
my $ev_err=$@||'';print "LINE=".__LINE__."\n";
if ($specialperms eq 'setuid' && $^O ne 'cygwin') {
unlink $Hosts{"__Master_${$}__"}{'FA_Core'}."ping$$.sh";print "LINE=".__LINE__."\n";
}
if ($ev_err) {
if (wantarray) {
return 0,
$Net::FullAuto::FA_Core::gbp->('ping').
"ping timed-out: $ev_err";print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
$Net::FullAuto::FA_Core::gbp->('ping').
"ping timed-out: $ev_err","-$didping");print "LINE=".__LINE__."\n";
}
}
if (-1<index $stderr,'is alive') {
$stdout=$stderr;print "LINE=".__LINE__."\n";
$stderr='';print "LINE=".__LINE__."\n";
}
$stdout=~s/^\s*//s;print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $stdout) {
chomp($line=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
if (-1<index $line,' from ' || -1<index $line,'is alive') {
if (wantarray) {
return $stdout,'';print "LINE=".__LINE__."\n";
} else {
return $stdout;print "LINE=".__LINE__."\n";
}
}
$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');print "LINE=".__LINE__."\n";
}
$stderr=~s/^(.*)$/ $1/mg if $stderr;print "LINE=".__LINE__."\n";
if (wantarray) {
return 0,$stderr;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
} else {
$didping+=30;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,"-$didping");print "LINE=".__LINE__."\n";
}
}
sub work_dirs
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "work_dirs() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $transfer_dir=$_[0];print "LINE=".__LINE__."\n";
$transfer_dir||='';print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $cmd_handle=$_[2];print "LINE=".__LINE__."\n";
bless $cmd_handle;print "LINE=".__LINE__."\n";
my $cmd_type=$_[3];print "LINE=".__LINE__."\n";
my $cygdrive=$_[4];print "LINE=".__LINE__."\n";
$cygdrive||='';print "LINE=".__LINE__."\n";
my $_connect=$_[5];print "LINE=".__LINE__."\n";
my ($output,$stderr,$regex)=('','','');print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if (-1<index $cmd_handle,'HASH') {
$regex=$cmd_handle->{_cygdrive_regex};print "LINE=".__LINE__."\n";
$cygdrive=$cmd_handle->{_cygdrive}
if exists $cmd_handle->{_cygdrive};print "LINE=".__LINE__."\n";
} elsif ($cygdrive) {
$regex=qr/^$cygdrive\//;print "LINE=".__LINE__."\n";
}
my $work_dirs={};print "LINE=".__LINE__."\n";
if ($transfer_dir) {
if (unpack('x1 a1',$transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$transfer_dir);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}=$transfer_dir.'\\';print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp}=$cygdrive
.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
} elsif ($cygdrive && $transfer_dir=~/$regex/) {
${$work_dirs}{_tmp}=$transfer_dir.'/';print "LINE=".__LINE__."\n";
(${$work_dirs}{_tmp_mswin}=$transfer_dir)
=~s/$regex//;print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}=~tr/\//\\/;print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}.='\\';print "LINE=".__LINE__."\n";
} 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);print "LINE=".__LINE__."\n";
} elsif (unpack('a1',$transfer_dir) eq '/') {
${$work_dirs}{_tmp}=$transfer_dir.'/';print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}='';print "LINE=".__LINE__."\n";
} else {
my $die="Cannot Locate Transfer Directory - $transfer_dir";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} ${$work_dirs}{_lcd}=${$work_dirs}{_tmp_lcd}
=$localhost->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
${$work_dirs}{_pre_lcd}='';print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
}
if (&Net::FullAuto::FA_Core::test_dir($cmd_handle->{_cmd_handle},'/tmp')
eq 'WRITE') {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp}='/tmp/';print "LINE=".__LINE__."\n";
if ($cmd_handle->{_uname} eq 'cygwin') {
my $pwd='';my $curdir='';my $cnt=5;print "LINE=".__LINE__."\n";
while ($cnt--) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&clean_filehandle($cmd_handle->{_cmd_handle});print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
($pwd,$stderr)=$cmd_handle->cmd('pwd');print "LINE=".__LINE__."\n";
next if $stderr;print "LINE=".__LINE__."\n";
if ($pwd=~/\n/s) {
my @split_on_newline=split "\n", $pwd;print "LINE=".__LINE__."\n";
$pwd=pop @split_on_newline;print "LINE=".__LINE__."\n";
} next if $pwd!~/^[\/]/;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=$cmd_handle->cmd(
"cd \"".${$work_dirs}{_tmp}."\"");print "LINE=".__LINE__."\n";
#&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
#$curdir=&attempt_cmd_xtimes($cmd_handle->{_cmd_handle},
# 'cmd /c chdir',$cmd_handle->{'hostlabel'}[0]);print "LINE=".__LINE__."\n";
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
my $cdr='';print "LINE=".__LINE__."\n";
if (exists $localhost->{_cygdrive} &&
-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;print "LINE=".__LINE__."\n";
my $cdr=unpack("x$l_cd a*",$curdir);print "LINE=".__LINE__."\n";
substr($cdr,1,0)=':';print "LINE=".__LINE__."\n";
$cdr=ucfirst($cdr);print "LINE=".__LINE__."\n";
$cdr=~s/\//\\\\/g;print "LINE=".__LINE__."\n";
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;print "LINE=".__LINE__."\n";
}
${$work_dirs}{_tmp_mswin}=$cdr.'\\\\';print "LINE=".__LINE__."\n";
}
($output,$stderr)=$cmd_handle->cmd(
'cd '."\"$pwd\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-2','__cleanup__') if $stderr;print "LINE=".__LINE__."\n";
} ${$work_dirs}{_lcd}=${$work_dirs}{_tmp_lcd}
=$localhost->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
${$work_dirs}{_pre_lcd}='';print "LINE=".__LINE__."\n";
return $work_dirs;print "LINE=".__LINE__."\n";
}
if ($cmd_handle->{_uname} eq 'cygwin') {
(${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
'temp','Temp',
$cmd_handle,$hostlabel);print "LINE=".__LINE__."\n";
if ($ms_share) {
my $host=($use eq 'ip')?$ip:$hostname;print "LINE=".__LINE__."\n";
${$work_dirs}{_cwd_mswin}="\\\\$host\\$ms_share\\";print "LINE=".__LINE__."\n";
}
return $work_dirs if ${$work_dirs}{_tmp};print "LINE=".__LINE__."\n";
} ${$work_dirs}{_tmp}=${$work_dirs}{_tmp_mswin}='';print "LINE=".__LINE__."\n";
${$work_dirs}{_lcd}=$localhost->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
${$work_dirs}{_pre_lcd}='';print "LINE=".__LINE__."\n";
return $work_dirs
}
sub close
{
return &File_Transfer::close(@_);print "LINE=".__LINE__."\n";
}
sub cwd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: main::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
if (!defined $_[1]) {
return Cwd::getcwd();print "LINE=".__LINE__."\n";
} else {
($stdout,$stderr)=File_Transfer::cwd(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $stdout,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&handle_error($stderr,'-4');print "LINE=".__LINE__."\n";
} return $stdout;print "LINE=".__LINE__."\n";
}
}
sub setuid_cmd
{
my @topcaller=caller; # Save Pound Sign
#print "setuid_cmd() CALLER=",(join ' ',@topcaller),"\n"
# if $Net::FullAuto::FA_Core::debug && $^O eq 'cygwin';print "LINE=".__LINE__."\n";
# 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,'*'; # Save Pound Sign
my $cmd=[]; # Save Pound Sign
$cmd = (ref $_[0] eq 'ARRAY') ? $_[0] : [ $_[0] ]; # Save Pound Sign
my $timeout=$_[1]||0; # Save Pound Sign
my $regex=''; # Save Pound Sign
if ($timeout) {
alarm($timeout+10); # Save Pound Sign
if (7<length $timeout &&
unpack('a8',$timeout) eq '(?-xism:') {
$regex=$timeout; # Save Pound Sign
$timeout=shift; # Save Pound Sign
$timeout||=''; # Save Pound Sign
}
if ($timeout!~/^\d+$/) {
undef $timeout; # Save Pound Sign
}
} else { alarm($Net::FullAuto::FA_Core::timeout) }
my $flag=shift; # Save Pound Sign
$flag||=''; # Save Pound Sign
my $cmd_err=''; # Save Pound Sign
$cmd_err=join ' ',@{$cmd} if ref $cmd eq 'ARRAY'; # Save Pound Sign
my $one=${$cmd}[0]||'';my $two=''; # Save Pound Sign
$two=${$cmd}[1] if 0<$#{$cmd}; # Save Pound Sign
my $three=''; # Save Pound Sign
$three=${$cmd}[2] if 1<$#{$cmd}; # Save Pound Sign
my $four=''; # Save Pound Sign
$four=${$cmd}[3] if 2<$#{$cmd}; # Save Pound Sign
my $five=''; # Save Pound Sign
$five=${$cmd}[4] if 3<$#{$cmd}; # Save Pound Sign
my $six=''; # Save Pound Sign
$six=${$cmd}[5] if 4<$#{$cmd}; # Save Pound Sign
my $seven=''; # Save Pound Sign
$seven=${$cmd}[6] if 5<$#{$cmd}; # Save Pound Sign
my $eight=''; # Save Pound Sign
$eight=${$cmd}[7] if 6<$#{$cmd}; # Save Pound Sign
if (!$one && ref $cmd ne 'ARRAY') {
$one=$cmd;$cmd_err=$cmd; # Save Pound Sign
}
$regex||='';my $pid='';my $output=''; # Save Pound Sign
my $stdout='';my $stderr=''; # Save Pound Sign
&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"; # Save Pound Sign
} else {
&Net::FullAuto::FA_Core::handle_error(
"Cmd $cmd_err returned tainted data"); # Save Pound Sign
}
} $output=~s/^\s*//s; # Save Pound Sign
if ($one!~/^[^ ]*clear$/) {
my @outlines=();my @errlines=(); # Save Pound Sign
foreach my $line (split /^/,$output) {
if ($line=~s/^[\t ]*stdout: //) {
push @outlines, $line; # Save Pound Sign
} else { push @errlines, $line }
} $stdout=join '', @outlines;$stderr=join '',@errlines; # Save Pound Sign
} else { $stdout=$output }
chomp $stdout;chomp $stderr; # Save Pound Sign
alarm(0); # Save Pound Sign
if (wantarray) {
return $stdout,$stderr; # Save Pound Sign
} else { return $stdout }
}
sub cmd
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
my $hlab='';print "LINE=".__LINE__."\n";
if ((-1<index $self,'HASH') && (exists $self->{_hostlabel})) {
$hlab=$self->{_hostlabel}->[0] || "localhost - ".hostname;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $escape=0;print "LINE=".__LINE__."\n";
my $cmd='';my $cmtimeout=$timeout;my $delay=0;print "LINE=".__LINE__."\n";
if (defined $_[1] && $_[1]) {
if ($_[1]=~/^[0-9]+$/) {
$cmtimeout=$_[1];print "LINE=".__LINE__."\n";
if (-1<index $self,'HASH') {
$_[1]=$cmtimeout=$Hosts{$self->{_hostlabel}->[0]}{'Timeout'}
if exists $Hosts{$self->{_hostlabel}->[0]}{'Timeout'};print "LINE=".__LINE__."\n";
}
} elsif ($_[1] eq '__escape__') {
$escape=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__delay__') {
$delay=1;print "LINE=".__LINE__."\n";
} else {
$cmd=$_[1];print "LINE=".__LINE__."\n";
}
}
if (defined $_[2] && $_[2]) {
if ($_[2]=~/^[0-9]+$/) {
$cmtimeout=$_[2];print "LINE=".__LINE__."\n";
$_[1]=$cmtimeout=$Hosts{$self->{_hostlabel}->[0]}{'Timeout'}
if exists $Hosts{$self->{_hostlabel}->[0]}{'Timeout'};print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__escape__') {
$escape=1;print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__delay__') {
$delay=1;print "LINE=".__LINE__."\n";
} else {
if ($_[2]!~/^__[a-z]+__$/) {
if (wantarray) {
return 0,'Third Argument for Timeout Value is not Whole Number';print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
} elsif ($_[3] eq '__delay__') {
$delay=1;print "LINE=".__LINE__."\n";
}
}
my $stderr='';my $stdout='';my $pid_ts='';print "LINE=".__LINE__."\n";
my $all='';my @outlines=();my @errlines=();print "LINE=".__LINE__."\n";
if (!$escape) {
if ((-1<index $self,'HASH')
&& exists $self->{_cmd_handle}
&& defined fileno $self->{_cmd_handle}) {
#my $logreset=1;print "LINE=".__LINE__."\n";
#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,'*';print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($self->{_cmd_handle});print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'__cleanup__') if $cfh_error;print "LINE=".__LINE__."\n";
sleep 1 if $delay;print "LINE=".__LINE__."\n";
#print "READY FOR CMD=@_\n";print "LINE=".__LINE__."\n";
eval {
($stdout,$stderr)=Rem_Command::cmd(@_);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
if ($stderr) {
$stderr.="\n $@";print "LINE=".__LINE__."\n";
} else {
$stderr=$@;print "LINE=".__LINE__."\n";
}
}
#print "WHAT IS STDERR FOR READY=$stderr<==\n";print "LINE=".__LINE__."\n";
if (wantarray) {
return $stdout,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');print "LINE=".__LINE__."\n";
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');print "LINE=".__LINE__."\n";
} else {
&handle_error($stderr,'-16');print "LINE=".__LINE__."\n";
}
} return $stdout;print "LINE=".__LINE__."\n";
#$Net::FullAuto::FA_Core::log=0 if $logreset;print "LINE=".__LINE__."\n";
}
if (defined $localhost &&
$localhost &&
(-1<index $localhost,'HASH')
&& exists $localhost->{_cmd_handle}
&& defined fileno $localhost->{_cmd_handle}) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);print "LINE=".__LINE__."\n";
&handle_error($cfh_error,'-1') if $cfh_error;print "LINE=".__LINE__."\n";
($stdout,$stderr)=$localhost->cmd(@_);print "LINE=".__LINE__."\n";
if (wantarray) {
return $stdout,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');print "LINE=".__LINE__."\n";
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');print "LINE=".__LINE__."\n";
} else {
&handle_error($stderr,'-16');print "LINE=".__LINE__."\n";
}
} return $stdout;print "LINE=".__LINE__."\n";
}
}
if ($^O eq 'cygwin') {
if ($self!~/^cd[\t ]/) {
$cmd="$self|perl -e \'\$o=join \"\",<STDIN>;\$o=~s/^/stdout: /mg;".
"print \$o,\"__STOP--\"\' 2>&1";print "LINE=".__LINE__."\n";
}
my $cmd_handle='';my $cmd_pid='';my $next=10;print "LINE=".__LINE__."\n";
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");print "LINE=".__LINE__."\n";
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cmtimeout);print "LINE=".__LINE__."\n";
$cmd_handle->telnetmode(0);print "LINE=".__LINE__."\n";
$cmd_handle->binmode(1);print "LINE=".__LINE__."\n";
my $first=0;print "LINE=".__LINE__."\n";
eval {
while (my $line=$cmd_handle->get(Timeout=>$cmtimeout)) {
chomp($line=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
next if $line=~/^\s*$/ && !$first;print "LINE=".__LINE__."\n";
$first=1;print "LINE=".__LINE__."\n";
$all.=$line;print "LINE=".__LINE__."\n";
last if $all=~s/\n*_\s*_\s*S\s*T\s*O\s*P\s*-\s*-\s*$//s;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
if ($@) {
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($cmd_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($cmd_pid);print "LINE=".__LINE__."\n";
$cmd_handle->close;print "LINE=".__LINE__."\n";
if ($next--) {
$all='';next;print "LINE=".__LINE__."\n";
} else { &cleanup }
} else { $cmd_handle->print("\004");last }
} $cmd_handle->close;print "LINE=".__LINE__."\n";
} else {
if ($self!~/^cd[\t ]/) {
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'sed'}) {
$sedpath=$Hosts{"__Master_${$}__"}{'sed'};print "LINE=".__LINE__."\n";
$sedpath.='/' if $sedpath!~/\/$/;print "LINE=".__LINE__."\n";
}
$cmd="$self | ${sedpath}sed -e \'s/^/stdout: /\' 2>&1";print "LINE=".__LINE__."\n";
}
($stdout,$stderr)=&setuid_cmd($cmd,$cmtimeout);print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
if ($all) {
foreach my $line (split /^/, $all) {
if ($line=~s/^[\t ]*stdout: //) {
push @outlines, $line;print "LINE=".__LINE__."\n";
} else { push @errlines, $line }
} $stdout=join '', @outlines;$stderr=join '',@errlines;print "LINE=".__LINE__."\n";
}
$stderr=~s/^\s*$//s;print "LINE=".__LINE__."\n";
if (wantarray) {
return $stdout,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');print "LINE=".__LINE__."\n";
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');print "LINE=".__LINE__."\n";
} else {
&handle_error($stderr,'-16');print "LINE=".__LINE__."\n";
}
} return $stdout;print "LINE=".__LINE__."\n";
}
sub tmp
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "PARENTTMPCALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "PARENTTMPCALLER=",
(join ' ',@topcaller), "\nand ARGS=@_\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return File_Transfer::tmp(@_);print "LINE=".__LINE__."\n";
}
sub print
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "PARENTPRINTCALLER=",(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
return Net::Telnet::print(@_);print "LINE=".__LINE__."\n";
}
sub scrub_passwd_file
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
my $track='';print "LINE=".__LINE__."\n";
print "scrub_passwd_file() CALLER=",(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $passlabel=$_[0];my $login_id=$_[1];print "LINE=".__LINE__."\n";
my $cmd_type=$_[2];print "LINE=".__LINE__."\n";
my @passlabels=();print "LINE=".__LINE__."\n";
my $local_host_flag=0;print "LINE=".__LINE__."\n";
if ($passlabel eq "__Master_${$}__") {
my $local_host_flag=0;print "LINE=".__LINE__."\n";
foreach my $passlab (keys %same_host_as_Master) {
next if $passlab eq "__Master_${$}__";print "LINE=".__LINE__."\n";
push @passlabels, $passlab;print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
if (!$local_host_flag) {
$passlabels[0]=$Net::FullAuto::FA_Core::local_hostname;print "LINE=".__LINE__."\n";
$local_host_flag=1;print "LINE=".__LINE__."\n";
}
} else {
$passlabels[0]=$passlabel;print "LINE=".__LINE__."\n";
}
foreach my $passlabel (@passlabels) {
my $key='';print "LINE=".__LINE__."\n";
if ($local_host_flag) {
$key="${username}_X_${passlabel}_X_${$}_X_$invoked[0]";print "LINE=".__LINE__."\n";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${passlabel}_X_${cmd_type}";print "LINE=".__LINE__."\n";
} else {
$key="${username}_X_${login_id}_X_${passlabel}";print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG "SCRUBBINGTHISKEY=$key<==\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $kind='prod';print "LINE=".__LINE__."\n";
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
return unless exists $Hosts{"__Master_${$}__"}{'FA_Secure'};print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "PAST THE DBENV INITIALIZATION<==\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $href='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($passlabel,$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
my $flag=0;my $successflag=0;print "LINE=".__LINE__."\n";
foreach my $ky (keys %{$href}) {
if ($ky eq $key) {
while (delete $href->{$key}) {}
$successflag=1;$flag=1;print "LINE=".__LINE__."\n";
} 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();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($passlabel,$put_href);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&release_fa_lock(9361);print "LINE=".__LINE__."\n";
return $successflag;print "LINE=".__LINE__."\n";
}
}
1;print "LINE=".__LINE__."\n";
package File_Transfer;print "LINE=".__LINE__."\n";
use Time::Local;print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
sub new {
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: File_Transfer::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
our $timeout=$Net::FullAuto::FA_Core::timeout;print "LINE=".__LINE__."\n";
our $test=$Net::FullAuto::FA_Core::test;print "LINE=".__LINE__."\n";
my $class = ref($_[0]) || $_[0];print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $new_master=$_[2]||'';print "LINE=".__LINE__."\n";
my $_connect=$_[3]||'';print "LINE=".__LINE__."\n";
my $cache=$_[4]||$main::cache||'';print "LINE=".__LINE__."\n";
my $self = { };print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
my $host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
my $chk_id='';print "LINE=".__LINE__."\n";
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"},'';print "LINE=".__LINE__."\n";
} else {
delete $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"};print "LINE=".__LINE__."\n";
}
} else {
return $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"},'';print "LINE=".__LINE__."\n";
}
}
my ($ftp_handle,$ftp_pid,$work_dirs,$homedir,$ftr_cmd,$ftm_type,
$cmd_type,$smb,$fpx_handle,$fpx_pid,$stderr)=
ftm_login($hostlabel,$new_master,$_connect,$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
$stderr=~s/(at .*)$/\n\n $1/s;print "LINE=".__LINE__."\n";
my $die="\n FATAL ERROR! - $stderr";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $ftp_handle,$die;print "LINE=".__LINE__."\n";
}
if ($smb) {
$self->{_hostlabel}=[ $hostlabel,
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0] ];print "LINE=".__LINE__."\n";
$self->{_smb}=1;print "LINE=".__LINE__."\n";
} else {
$self->{_hostlabel}=[ $hostlabel,'' ];print "LINE=".__LINE__."\n";
}
if ($ftr_cmd) {
$self->{_cmd_handle}=$ftr_cmd->{_cmd_handle};print "LINE=".__LINE__."\n";
$self->{_sh_pid}=$ftr_cmd->{_sh_pid};print "LINE=".__LINE__."\n";
$self->{_cmd_pid}=$ftr_cmd->{_cmd_pid};print "LINE=".__LINE__."\n";
$self->{_uname}=$ftr_cmd->{_uname};print "LINE=".__LINE__."\n";
$self->{_luname}=$ftr_cmd->{_luname};print "LINE=".__LINE__."\n";
$self->{_cmd_type}=$cmd_type;print "LINE=".__LINE__."\n";
if ($ftr_cmd->{_cygdrive}) {
$self->{_cygdrive}=$ftr_cmd->{_cygdrive};print "LINE=".__LINE__."\n";
$self->{_cygdrive_regex}=$ftr_cmd->{_cygdrive_regex};print "LINE=".__LINE__."\n";
}
} else {
$self->{_uname}=$uname;print "LINE=".__LINE__."\n";
$self->{_luname}=$^O;print "LINE=".__LINE__."\n";
if (-1==$#{$cmd_cnct}) {
$self->{_cmd_handle}=$ftp_handle;print "LINE=".__LINE__."\n";
$self->{_cmd_type}=$ftm_type;
} else {
$self->{_cmd_handle}='';print "LINE=".__LINE__."\n";
$self->{_cmd_type}='';print "LINE=".__LINE__."\n";
}
}
$self->{_ftp_handle}=$ftp_handle;print "LINE=".__LINE__."\n";
$self->{_fpx_handle}=$fpx_handle
if $self->{_fpx_handle};print "LINE=".__LINE__."\n";
$self->{_hostname}=$hostname;print "LINE=".__LINE__."\n";
$self->{_ip}=$ip;print "LINE=".__LINE__."\n";
$self->{_connect}=$_connect;print "LINE=".__LINE__."\n";
$self->{_ftm_type}=$ftm_type;print "LINE=".__LINE__."\n";
$self->{_work_dirs}=$work_dirs;print "LINE=".__LINE__."\n";
$self->{_ftp_pid}=$ftp_pid if $ftp_pid;print "LINE=".__LINE__."\n";
$self->{_fpx_pid}=$fpx_pid if $fpx_pid;print "LINE=".__LINE__."\n";
$self->{_homedir}=$homedir;print "LINE=".__LINE__."\n";
bless($self,$class);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$chk_id"}=$self;print "LINE=".__LINE__."\n";
return $self,'';print "LINE=".__LINE__."\n";
}
sub handle_error
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
return &Net::FullAuto::FA_Core::handle_error(@_);print "LINE=".__LINE__."\n";
}
sub close
{
my $self=$_[0];print "LINE=".__LINE__."\n";
if (exists $self->{_ftp_handle} &&
defined fileno $self->{_ftp_handle}) {
my $ftp_handle=$self->{_ftp_handle};print "LINE=".__LINE__."\n";
my $count=0;print "LINE=".__LINE__."\n";
eval {
SC: while (defined fileno $self->{_ftp_handle}) {
$self->{_ftp_handle}->print("\004");print "LINE=".__LINE__."\n";
while (my $line=$self->{_ftp_handle}->get) {
last if $line=~/_funkyPrompt_$|
Connection.*closed|logout|221\sGoodbye/sx;print "LINE=".__LINE__."\n";
if ($line=~/^\s*$/s) {
last SC if $count++==20;print "LINE=".__LINE__."\n";
} else { $count=0 }
$self->{_ftp_handle}->print("\004");print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
eval { $self->{_ftp_handle}->close };print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$self->{_ftp_pid},$kill_arg)
if &Net::FullAuto::FA_Core::testpid($self->{_ftp_pid});print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
}
}
sub clean_filehandle
{
return &Net::FullAuto::FA_Core::clean_filehandle(@_);print "LINE=".__LINE__."\n";
}
sub get_vlabel
{
print "GET_VLABEL_CALLER=",caller,"\n";<STDIN>;print "LINE=".__LINE__."\n";
my ($self,$deploy_type,$dest_hostlabel,
$base_hostlabel,$archivedir) = @_;print "LINE=".__LINE__."\n";
my ($archive_hostlabel,$version_label,$label1,$label2)='';print "LINE=".__LINE__."\n";
my @output=();print "LINE=".__LINE__."\n";
if ($deploy_type eq 'get') {
$archive_hostlabel=$dest_hostlabel;print "LINE=".__LINE__."\n";
} else {
$archive_hostlabel=$base_hostlabel;print "LINE=".__LINE__."\n";
}
while ($Net::FullAuto::FA_Core::version_label eq '') {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n\n Please Type the Version Number of the\n";print "LINE=".__LINE__."\n";
print " Build being Deployed TO Host \"$dest_hostlabel\"\n";print "LINE=".__LINE__."\n";
print " FROM Host \"$base_hostlabel\" : ";print "LINE=".__LINE__."\n";
$label1=<STDIN>;chomp($label1);print "LINE=".__LINE__."\n";
next if $label1 eq '';print "LINE=".__LINE__."\n";
if ($label1 ne uc($label1)) {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n\n ERROR! - Use Only Upper Case Letters ",
"for Version Labels!";print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
print "\n Please Re-Enter the Version Number : ";print "LINE=".__LINE__."\n";
$label2=<STDIN>;chomp($label2);print "LINE=".__LINE__."\n";
if ($label1 eq "") {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
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='';print "LINE=".__LINE__."\n";
my %settings=();print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
}
if (-d "$archivedir") {
if (-f "$archivedir/mving.flg") {
$version_label=$label1;last;print "LINE=".__LINE__."\n";
} else {
my $target=$archive_hostlabel;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$die,'__cleanup__');print "LINE=".__LINE__."\n";
}
} elsif ($^O ne 'cygwin' && $^O ne 'MSWin32'
&& $^O ne 'MSWin64'
&& $ENV{OS} ne 'Windows_NT') {
#### DO ERROR TRAPPING!!!!!!!!!!!!
#print "MKDIR1=$archivedir\n";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
$Net::FullAuto::FA_Core::gbp->('mkdir')."mkdir \'/$archivedir\'");print "LINE=".__LINE__."\n";
my $chmod=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Chmod'};print "LINE=".__LINE__."\n";
my $own=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Owner'};print "LINE=".__LINE__."\n";
my $grp=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Group'};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chmod -v \"$chmod\" \'/$archivedir\'")
if $chmod;print "LINE=".__LINE__."\n";
@output=$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chown \"$own\" \'/$archivedir\'")
if $own;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chgrp \"$grp\" \'/$archivedir\'")
if $grp;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"touch \"/$archivedir/mving.flg\"");print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chmod -v \"$chmod\" \"/$archivedir/mving.flg\"")
if $chmod;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chown \"$own\" \"/$archivedir/mving.flg\"")
if $own;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chgrp \"$grp\" \"/$archivedir/mving.flg\"")
if $grp;print "LINE=".__LINE__."\n";
$version_label=$label1;last;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' || $^O eq 'MSWin32' || $^O eq 'MSWin64'
|| $ENV{OS} eq 'Windows_NT') {
print "DO MORE WORK ON MSWIN!\n";<STDIN>;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"mkdir -m 777 $label1");print "LINE=".__LINE__."\n";
$version_label=$label1;last;print "LINE=".__LINE__."\n";
}
}
} else { $version_label=$label1;last }
} else { $version_label=$label1;last }
} else {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n\n Version Numbers Do NOT Match!";print "LINE=".__LINE__."\n";
}
} print "\n\n";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::version_label=$version_label;print "LINE=".__LINE__."\n";
return $version_label;print "LINE=".__LINE__."\n";
}
sub select_dir
{
#print "SELECT_DIRCALLER=",caller,"\n";print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
my $dir='.';my $random=0;print "LINE=".__LINE__."\n";
my $dots=0;my $dot=0;my $dotdot=0;print "LINE=".__LINE__."\n";
if (defined $_[1] && $_[1]) {
if ($_[1] eq '__random__') {
$random=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__dots__') {
$dots=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__dot__') {
$dot=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__dotdot__') {
$dotdot=1;print "LINE=".__LINE__."\n";
} else {
$dir=$_[1];print "LINE=".__LINE__."\n";
}
}
if (defined $_[2] && $_[2]) {
if ($_[2] eq '__random__') {
$random=1;print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__dots__') {
$dots=1;print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__dot__') {
$dot=1;print "LINE=".__LINE__."\n";
} elsif ($_[2] eq '__dotdot__') {
$dotdot=1;print "LINE=".__LINE__."\n";
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__random__') {
$random=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__dots__') {
$dots=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__dot__') {
$dot=1;print "LINE=".__LINE__."\n";
} elsif ($_[1] eq '__dotdot__') {
$dotdot=1;print "LINE=".__LINE__."\n";
}
}
my $caller=(caller)[2];print "LINE=".__LINE__."\n";
my $hostlabel=$self->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
my $host= ($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
$ms_share||='';my %output=();my $nt5=0;print "LINE=".__LINE__."\n";
my $output='';my $stderr='';my $i=0;my @output=();print "LINE=".__LINE__."\n";
if ($ms_share || $self->{_uname} eq 'cygwin') {
my $test_chr1='';my $test_chr2='';print "LINE=".__LINE__."\n";
if ($dir) {
$test_chr1=unpack('a1',$dir);print "LINE=".__LINE__."\n";
if (1<length $dir) {
$test_chr2=unpack('a2',$dir);print "LINE=".__LINE__."\n";
}
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:/;print "LINE=".__LINE__."\n";
$dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
} elsif ($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') {
$dir=&File_Transfer::get_drive($dir,'Target',
'',$hostlabel);print "LINE=".__LINE__."\n";
$dir=~s/^$self->{_cygdrive_regex}//;print "LINE=".__LINE__."\n";
$dir=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
$dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
} else {
$dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dir="\\\\$host\\$ms_share\\"
. unpack('x1 a*',$dir);print "LINE=".__LINE__."\n";
}
} 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);print "LINE=".__LINE__."\n";
my $curdir='';print "LINE=".__LINE__."\n";
($curdir,$stderr)=
&Net::FullAuto::FA_Core::cmd($localhost,'pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $cdr='';print "LINE=".__LINE__."\n";
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;print "LINE=".__LINE__."\n";
my $cdr=unpack("x$l_cd a*",$curdir);print "LINE=".__LINE__."\n";
substr($cdr,1,0)=':';print "LINE=".__LINE__."\n";
$cdr=ucfirst($cdr);print "LINE=".__LINE__."\n";
$cdr=~s/\//\\\\/g;print "LINE=".__LINE__."\n";
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;print "LINE=".__LINE__."\n";
}
$dir="$cdr\\$dir";print "LINE=".__LINE__."\n";
} else {
$dir="\\\\$host\\$ms_share\\$dir";print "LINE=".__LINE__."\n";
}
} else {
&Net::FullAuto::FA_Core::handle_error(
"Target Directory (1) - $dir CANNOT Be Located");print "LINE=".__LINE__."\n";
}
} 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);print "LINE=".__LINE__."\n";
$dir=~s/^$self->{_cygdrive_regex}//;print "LINE=".__LINE__."\n";
$dir=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
$dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
} else {
$dir="\\\\$host\\$ms_share";print "LINE=".__LINE__."\n";
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
$dir=$test_chr1 . ':/';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"Target Directory (2) - $dir CANNOT Be Located");print "LINE=".__LINE__."\n";
} $dir=~tr/\\/\//;$dir=~tr/\//\\/;$dir=~s/\\/\\\\/g;my $cnt=0;print "LINE=".__LINE__."\n";
} else {
if (($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') ||
$self->{_work_dirs}->{_cwd}=~/^$self->{_cygdrive_regex}/) {
$dir=&File_Transfer::get_drive('/','Target','',$hostlabel);print "LINE=".__LINE__."\n";
$dir=~s/^$self->{_cygdrive_regex}//;print "LINE=".__LINE__."\n";
$dir=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
$dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
} else {
$dir="\\\\$host\\$ms_share";print "LINE=".__LINE__."\n";
}
}
my $cnt=0;print "LINE=".__LINE__."\n";
while (1) {
($output,$stderr)=$self->cmd("cmd /c dir /-C \"$dir\"");print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-6');print "LINE=".__LINE__."\n";
} else { last }
}
if (!$stderr) {
$output=~s/^.*Directory of (.*)$/$1/s;print "LINE=".__LINE__."\n";
my $mn=0;my $dy=0;my $yr=0;print "LINE=".__LINE__."\n";
my $hr=0;my $mt='';my $pm='';my $size='';print "LINE=".__LINE__."\n";
my $file='';my $filetime=0;my $cnt=0;print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $output) {
next if $cnt++<4;print "LINE=".__LINE__."\n";
next if -1==index $line,'<DIR>';print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
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");print "LINE=".__LINE__."\n";
$nt5=1;print "LINE=".__LINE__."\n";
} 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");print "LINE=".__LINE__."\n";
}
$filetime=timelocal(
0,$mt,$Net::FullAuto::FA_Core::hours{$hr.$pm},$dy,$mn-1,$yr);print "LINE=".__LINE__."\n";
} push @{$output{$filetime}},
{$file=>"$mn/$dy/$yr $hr:$mt$pm"};print "LINE=".__LINE__."\n";
}
foreach my $filetime (reverse sort keys %output) {
foreach my $filehash (@{$output{$filetime}}) {
foreach my $file (reverse sort keys %{$filehash}) {
push @output,${$filehash}{$file}." $file";print "LINE=".__LINE__."\n";
}
}
}
}
} else {
($output,$stderr)=$self->cmd("ls -lt $dir");print "LINE=".__LINE__."\n";
if (!$stderr) {
my $lchar_flag=0;print "LINE=".__LINE__."\n";
foreach my $line (split /\n/, $output) {
next if unpack('a5',$line) eq 'total';print "LINE=".__LINE__."\n";
my $lchar=substr($line,-1);print "LINE=".__LINE__."\n";
if ($lchar eq '*' || $lchar eq '/' || $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$lchar_flag=1;print "LINE=".__LINE__."\n";
}
chop $line;print "LINE=".__LINE__."\n";
}
my $endofline=substr($line,-2);print "LINE=".__LINE__."\n";
if ($endofline eq '..' && !$dots && !$dotdot) { next }
if ($endofline eq ' .' && !$dots && !$dot) { next }
my $date=substr($line,41,13);print "LINE=".__LINE__."\n";
my $file=unpack('x54 a*',$line);print "LINE=".__LINE__."\n";
push @output,"$date $file";print "LINE=".__LINE__."\n";
}
}
} my $die='';print "LINE=".__LINE__."\n";
if ($stderr) {
my $caller=(caller(1))[3];print "LINE=".__LINE__."\n";
substr($caller,0,(index $caller,'::')+2)='';print "LINE=".__LINE__."\n";
my $sub='';print "LINE=".__LINE__."\n";
if ($caller eq 'connect_ftp'
|| $caller eq 'connect_telnet') {
($caller,$sub)=split '::', (caller(2))[3];print "LINE=".__LINE__."\n";
$caller.='.pm';print "LINE=".__LINE__."\n";
} else {
my @called=caller(2);print "LINE=".__LINE__."\n";
if ($caller eq 'mirror' || $caller eq 'login_retry') {
$sub=$called[3]
} else {
$caller=$called[3];print "LINE=".__LINE__."\n";
$called[6]||='';print "LINE=".__LINE__."\n";
$sub=($called[6])?$called[6]:$called[3];print "LINE=".__LINE__."\n";
} $sub=~s/\s*\;\n*//
}
my $mod='';($mod,$sub)=split '::', $sub;print "LINE=".__LINE__."\n";
$stderr=~s/\sat\s${progname}\s/\n at ${progname} /;print "LINE=".__LINE__."\n";
$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";print "LINE=".__LINE__."\n";
} elsif ($random) {
$output=$output[rand $#output];
chomp $output;print "LINE=".__LINE__."\n";
if ($ms_share) {
if ($nt5) {
substr($output,0,19)="";print "LINE=".__LINE__."\n";
} else {
substr($output,0,21)="";print "LINE=".__LINE__."\n";
}
} else { substr($output,0,16)="" }
$output=~s/\s*$//;print "LINE=".__LINE__."\n";
} else {
my $banner="\n Please Pick a Directory :";print "LINE=".__LINE__."\n";
$output=&Menus::pick(\@output,$banner);print "LINE=".__LINE__."\n";
chomp $output;print "LINE=".__LINE__."\n";
if ($output ne ']quit[') {
if ($ms_share) {
if ($nt5) {
substr($output,0,19)="";print "LINE=".__LINE__."\n";
} else {
substr($output,0,21)="";print "LINE=".__LINE__."\n";
}
} else { substr($output,0,16)="" }
} else { &Net::FullAuto::FA_Core::cleanup() }
$output=~s/\s*$//;print "LINE=".__LINE__."\n";
}
if (wantarray) {
return $output,$die;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} else { return $output }
}
sub testfile
{
#print "TESTFILE_CALLER=",caller,"\n";print "LINE=".__LINE__."\n";
my ($self, @args) = @_;print "LINE=".__LINE__."\n";
my @output=();print "LINE=".__LINE__."\n";
my $output="";print "LINE=".__LINE__."\n";
eval {
$output=$self->cmd("ls -l @args");print "LINE=".__LINE__."\n";
print "OBJECT=$output\n";<STDIN>;print "LINE=".__LINE__."\n";
}
}
sub testdir
{
print "TESTDIR_CALLER=",caller,"\n";print "LINE=".__LINE__."\n";
my ($self, @args) = @_;print "LINE=".__LINE__."\n";
my @output=();print "LINE=".__LINE__."\n";
my $output="";print "LINE=".__LINE__."\n";
#eval {
}
sub ftp
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::ftp() CALLER=",
(join ' ',@topcaller),"\n";# if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my ($host1,$host2,$ftpcmd,$cache) = @_;print "LINE=".__LINE__."\n";
$ftpcmd=~s/^\s*//;print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
my $gpcmd='';print "LINE=".__LINE__."\n";
$gpcmd=unpack('a3',$ftpcmd) if 2<length $ftpcmd;print "LINE=".__LINE__."\n";
eval {
if ($host2) {
if ($gpcmd eq 'get') {
($output,$stderr)=Rem_Command::cmd(
$host2,$ftpcmd,'__ftp__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd(
$host1,$ftpcmd,'__ftp__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} elsif ($host2 && $gpcmd eq 'put') {
($output,$stderr)=Rem_Command::cmd(
$host1,$ftpcmd,'__ftp__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd(
$host2,$ftpcmd,'__ftp__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
} else {
$ftpcmd=~s/\\/\\\\/g if -1==index $ftpcmd,'\\\\';print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd(
$host1,$ftpcmd,'__ftp__');print "LINE=".__LINE__."\n";
my $die='';print "LINE=".__LINE__."\n";
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 ";print "LINE=".__LINE__."\n";
} else {
$die="\n FATAL ERROR! - The System "
."\"$host1->{_hostlabel}->[0]\" Returned "
."\n the Following Unrecoverable Error "
."Condition:\n\n ";print "LINE=".__LINE__."\n";
}
if ($output eq 'Not connected') {
$die.="$output\n ";print "LINE=".__LINE__."\n";
return '',$die;print "LINE=".__LINE__."\n";
} 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 ";print "LINE=".__LINE__."\n";
return '',$die;print "LINE=".__LINE__."\n";
} elsif (-1<index($output,'No such file or directory')) {
$die.="$output\n\n From ftp CMD: $ftpcmd\n\n ";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-26');print "LINE=".__LINE__."\n";
} $die.="$stderr\n ";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-28') if $stderr;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
$stderr=$@ if $@;print "LINE=".__LINE__."\n";
if (wantarray) {
return $output,$stderr;print "LINE=".__LINE__."\n";
} else { return $output }
}
sub cmd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: File_Transfer::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $command='';my $cache='';print "LINE=".__LINE__."\n";
my ($self,@args) = @_;print "LINE=".__LINE__."\n";
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;print "LINE=".__LINE__."\n";
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;print "LINE=".__LINE__."\n";
}
$cache||='';print "LINE=".__LINE__."\n";
$command=$args[0];print "LINE=".__LINE__."\n";
my @output=();my $cmdlin=0;print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
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') && unpack('a1',$command) ne '!') ||
($^O eq 'cygwin' &&
exists $self->{_smb})) {
$cmdlin=29;print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd($self,@args,$cache);print "LINE=".__LINE__."\n";
} elsif ($self->{_ftm_type} eq 'ftp' ||
$self->{_ftm_type} eq 'sftp') {
($output,$stderr)=&Rem_Command::ftpcmd($self,$command,$cache);print "LINE=".__LINE__."\n";
$cmdlin=26;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_cmd_type} .
" protocol not supported for command interface: ");print "LINE=".__LINE__."\n";
}
} else {
$cmdlin=9;print "LINE=".__LINE__."\n";
($output,$stderr)=&Net::FullAuto::FA_Core::cmd($command);print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
#if ($@) {
# print "$self->{_cmd_type} CMD ERROR! - $@\n";exit;print "LINE=".__LINE__."\n";
#}
if (wantarray) {
return $output,$stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr) {
&Net::FullAuto::FA_Core::handle_error($stderr,-$cmdlin) if $stderr;print "LINE=".__LINE__."\n";
} else { return $output }
}
sub ls
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::ls() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my ($self, $options, $path, $cache) = @_;print "LINE=".__LINE__."\n";
$path='' unless defined $path;print "LINE=".__LINE__."\n";
$options='' unless defined $options;print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
if ($path && unpack('a1',$path) eq '"') {
$path=unpack('a1 a*',$path);print "LINE=".__LINE__."\n";
substr($path,-1)='';print "LINE=".__LINE__."\n";
}
if ($path) {
($output,$stderr)=&Rem_Command::ftpcmd($self,"ls \"$path\"",$cache);print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=&Rem_Command::ftpcmd($self,'ls',$cache);print "LINE=".__LINE__."\n";
}
my $newout='';print "LINE=".__LINE__."\n";
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+.*/;print "LINE=".__LINE__."\n";
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;print "LINE=".__LINE__."\n";
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/;print "LINE=".__LINE__."\n";
$newout.=$line;print "LINE=".__LINE__."\n";
}
} $output=$newout if $newout;print "LINE=".__LINE__."\n";
}
return '',$stderr if $stderr;print "LINE=".__LINE__."\n";
chomp($output=~tr/\0-\11\13-\37\177-\377//d);$output=~s/^\s+//;print "LINE=".__LINE__."\n";
return $output,'';print "LINE=".__LINE__."\n";
}
sub lcd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::lcd() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::lcd() CALLER=",
(join ' ',@topcaller),
"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
#"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my ($self, $path, $cache) = @_;print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
if (unpack('a1',$path) eq '"') {
$path=unpack('a1 a*',$path);print "LINE=".__LINE__."\n";
substr($path,-1)='';print "LINE=".__LINE__."\n";
}
$self->{_work_dirs}->{_pre_lcd}=$self->{_work_dirs}->{_lcd};print "LINE=".__LINE__."\n";
$path=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::lcd() PATH=$path<==\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd($self,"lcd \"$path\"",$cache);print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_lcd}=$path;print "LINE=".__LINE__."\n";
return '',$stderr if $stderr;print "LINE=".__LINE__."\n";
return $output,'';print "LINE=".__LINE__."\n";
}
sub get
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::get() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $cache='';print "LINE=".__LINE__."\n";
my ($self, @args) = @_;print "LINE=".__LINE__."\n";
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;print "LINE=".__LINE__."\n";
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;print "LINE=".__LINE__."\n";
}
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
my $path='';my $file='';print "LINE=".__LINE__."\n";
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,'/'));print "LINE=".__LINE__."\n";
$file=substr($file_arg,(rindex $file_arg,'/')+1);print "LINE=".__LINE__."\n";
$path=~s/^~/$self->{_home_dir}/;print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd($self,
"cd \"$path\"",$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $file_arg,'\\') {
$path=substr($file_arg,0,(rindex $file_arg,'\\'));print "LINE=".__LINE__."\n";
$file=substr($file_arg,(rindex $file_arg,'\\')+1);print "LINE=".__LINE__."\n";
$path=~s/^~/$self->{_home_dir}/;print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd($self,
"cd \"$path\"",$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');print "LINE=".__LINE__."\n";
}
}
} else { $file=$file_arg }
} else { $file=$file_arg }
unless (&Net::FullAuto::FA_Core::acquire_fa_lock($file_arg)) {
return 'SEMAPHORE','' if wantarray;print "LINE=".__LINE__."\n";
return 'SEMAPHORE';print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd($self,
"get \"$file\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock($file_arg);print "LINE=".__LINE__."\n";
if ($stderr) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "GET ERROR! - $stderr\n";print "LINE=".__LINE__."\n";
}
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');print "LINE=".__LINE__."\n";
}
} elsif (wantarray) {
return $output,'';print "LINE=".__LINE__."\n";
} else {
return $output;print "LINE=".__LINE__."\n";
}
} elsif (wantarray) {
return '',
"YOU ARE TRYING TO FTP GET FILE TO THE SAME BOX :\n ".($!);print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"YOU ARE TRYING TO FTP GET FILE TO THE SAME BOX :\n ".($!));print "LINE=".__LINE__."\n";
}
} return $output,'' if wantarray;print "LINE=".__LINE__."\n";
return $output;print "LINE=".__LINE__."\n";
}
sub put
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::put() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $cache='';print "LINE=".__LINE__."\n";
my ($self, @args) = @_;print "LINE=".__LINE__."\n";
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;print "LINE=".__LINE__."\n";
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;print "LINE=".__LINE__."\n";
}
my ($output,$stderr)='';print "LINE=".__LINE__."\n";
foreach my $file (@args) {
if ($self->{_ftp_handle} ne "__Master_${$}__") {
$file=~s/^~/$self->{_home_dir}/;print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd($self,
"put $file",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock($file);print "LINE=".__LINE__."\n";
if ($stderr) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "PUT ERROR! - $stderr\n";print "LINE=".__LINE__."\n";
}
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');print "LINE=".__LINE__."\n";
}
} elsif (wantarray) {
return $output,'';print "LINE=".__LINE__."\n";
} else {
return $output;print "LINE=".__LINE__."\n";
}
} elsif (wantarray) {
return '',
"YOU ARE TRYING TO FTP PUT FILE TO THE SAME BOX :\n ".($!);print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"YOU ARE TRYING TO FTP PUT FILE TO THE SAME BOX :\n ".($!));print "LINE=".__LINE__."\n";
}
}
}
sub size
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::size() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $cache='';print "LINE=".__LINE__."\n";
my ($self, @args) = @_;print "LINE=".__LINE__."\n";
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;print "LINE=".__LINE__."\n";
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;print "LINE=".__LINE__."\n";
}
my ($output,$stderr)='';print "LINE=".__LINE__."\n";
foreach my $file (@args) {
if ($self->{_ftp_handle} ne "__Master_${$}__") {
($output,$stderr)=&Rem_Command::ftpcmd($self,
"get $file",$cache);print "LINE=".__LINE__."\n";
} else {
$output=(stat("$file"))[7] || ($stderr=
"cannot stat and obtain file size for $file\n $!");print "LINE=".__LINE__."\n";
}
if ($stderr) {
print "ERROR! - $stderr\n";print "LINE=".__LINE__."\n";
}
}
}
sub ftr_cmd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::ftr_cmd() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $hostlabel=$_[0];print "LINE=".__LINE__."\n";
my $ftp_handle=$_[1];print "LINE=".__LINE__."\n";
my $new_master=$_[2]||'';print "LINE=".__LINE__."\n";
my $_connect=$_[3]||'';print "LINE=".__LINE__."\n";
my $cache=$_[4]||'';print "LINE=".__LINE__."\n";
our @rcm_map=();our $track='';print "LINE=".__LINE__."\n";
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)=('','','','','','','','','',
'','','','','','','','','');print "LINE=".__LINE__."\n";
($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);print "LINE=".__LINE__."\n";
my $host= ($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
$ms_share='' unless defined $ms_share;print "LINE=".__LINE__."\n";
$ms_domain='' unless defined $ms_domain;print "LINE=".__LINE__."\n";
$login_id=&Net::FullAuto::FA_Core::username() if !defined $su_id;print "LINE=".__LINE__."\n";
my $work_dirs={};my $ftr_cmd='';my $ms_su_id='';my $ms_login_id='';print "LINE=".__LINE__."\n";
my $ms_hostlabel='';my $ms_host='';my $ms_ms_share='';print "LINE=".__LINE__."\n";
my $local_transfer_dir='';my $cmd_type='';my $ms_ms_domain='';print "LINE=".__LINE__."\n";
my $output='';my $stderr='';my $ms_transfer_dir='';my $smb=0;print "LINE=".__LINE__."\n";
my @output=();my $cw1='';my $cw2='';my $ftm_type='';print "LINE=".__LINE__."\n";
foreach my $cnct (@{$cmd_cnct}) {
$cmd_type=lc($cnct);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($stderr) {
chomp $stderr;print "LINE=".__LINE__."\n";
return '','','','',$stderr;print "LINE=".__LINE__."\n";
}
$cmd_type=$ftr_cmd->{_cmd_type};print "LINE=".__LINE__."\n";
$ftr_cmd->{_ftp_handle}=$ftp_handle;print "LINE=".__LINE__."\n";
if (defined $transfer_dir && $transfer_dir) {
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftr_cmd,$cmd_type,'',$_connect);print "LINE=".__LINE__."\n";
my $curdir='';print "LINE=".__LINE__."\n";
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($ftr_cmd,'pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $cdr='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$ftr_cmd,"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;print "LINE=".__LINE__."\n";
}
${$work_dirs}{_pre_mswin}=$cdr.'\\\\';print "LINE=".__LINE__."\n";
$ftr_cmd->{_cygdrive}||='/';print "LINE=".__LINE__."\n";
$work_dirs->{_pre}=$curdir;print "LINE=".__LINE__."\n";
($output,$stderr)=$ftr_cmd->cmd('cd '.$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
if ($stderr) {
@FA_Core::tran=();print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-5');print "LINE=".__LINE__."\n";
}
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
$output=join '',
$ftr_cmd->{_ftp_handle}->cmd('cd '.$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
if ($output=~/^(5.*)$/m) {
my $line=$1;print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $line";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-7');print "LINE=".__LINE__."\n";
}
$work_dirs->{_cwd}=$work_dirs->{_tmp};print "LINE=".__LINE__."\n";
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$ftr_cmd->{_ftp_handle}}{cd}
=${$work_dirs}{_tmp};print "LINE=".__LINE__."\n";
} 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'};print "LINE=".__LINE__."\n";
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftr_cmd,$cmd_type,'',$_connect);print "LINE=".__LINE__."\n";
$work_dirs->{_pre}=$work_dirs->{_cwd}='';print "LINE=".__LINE__."\n";
$work_dirs->{_pre_mswin}=$work_dirs->{_cwd_mswin}=
"\\\\$host\\$ms_share\\";print "LINE=".__LINE__."\n";
($output,$stderr)=$ftr_cmd->cmd('cd '.$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
if ($stderr) {
@FA_Core::tran=();print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-5');print "LINE=".__LINE__."\n";
}
$output=join '',
$ftr_cmd->{_ftp_handle}->cmd('cd '.$work_dirs->{_tmp});print "LINE=".__LINE__."\n";
if ($output=~/^(5.*)$/m) {
my $line=$1;print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $line";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-7');print "LINE=".__LINE__."\n";
} $Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$ftr_cmd->{_ftp_handle}}{cd}=
$work_dirs->{_tmp};print "LINE=".__LINE__."\n";
$smb=1;print "LINE=".__LINE__."\n";
} else {
my $curdir='';print "LINE=".__LINE__."\n";
if ($ftr_cmd->{_uname} eq 'cygwin') {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
my $cdr='';print "LINE=".__LINE__."\n";
if (exists $localhost->{_cygdrive} &&
-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;print "LINE=".__LINE__."\n";
my $cdr=unpack("x$l_cd a*",$curdir);print "LINE=".__LINE__."\n";
substr($cdr,1,0)=':';print "LINE=".__LINE__."\n";
$cdr=ucfirst($cdr);print "LINE=".__LINE__."\n";
$cdr=~s/\//\\\\/g;print "LINE=".__LINE__."\n";
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
}
$work_dirs->{_pre_mswin}=
$work_dirs->{_cwd_mswin}=$cdr.'\\\\';print "LINE=".__LINE__."\n";
$work_dirs->{_tmp_mswin}=
$ftr_cmd->{_work_dirs}->{_tmp_mswin};print "LINE=".__LINE__."\n";
}
$work_dirs->{_pre}=$work_dirs->{_cwd}=$curdir;print "LINE=".__LINE__."\n";
$work_dirs->{_tmp}=$ftr_cmd->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;print "LINE=".__LINE__."\n";
} else {
my $cnt=3;print "LINE=".__LINE__."\n";
while ($cnt--) {
($curdir,$stderr)=$ftr_cmd->cmd('pwd');print "LINE=".__LINE__."\n";
if (!$curdir) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
} else {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
last
}
}
$curdir.='/' if $curdir ne '/';print "LINE=".__LINE__."\n";
$work_dirs->{_pre}=$work_dirs->{_cwd}=$curdir;print "LINE=".__LINE__."\n";
$work_dirs->{_tmp}=$ftr_cmd->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;print "LINE=".__LINE__."\n";
}
} return $work_dirs,$ftr_cmd,$cmd_type,$ftm_type,'' if $ftr_cmd;print "LINE=".__LINE__."\n";
} elsif ($rcm_chain) {
if ($rcm_map && ref $rcm_map ne 'ARRAY') {
$rcm_map=[$rcm_map];print "LINE=".__LINE__."\n";
} else { $rcm_map=[] }
sub recurse_chain {
print "RECURSECALLER=",caller," and ZERO=$_[0]\n";<STDIN>;print "LINE=".__LINE__."\n";
print "ZERO=",join ' ',@{$_[0]}," and ONE=$_[1] and TWO=$_[2] and TEE=$_[3]\n";<STDIN>;print "LINE=".__LINE__."\n";
my @rcm_chain=@{$_[0]};print "LINE=".__LINE__."\n";
my $ftr_cmd = defined $_[1] ? $_[1] : '';;print "LINE=".__LINE__."\n";
my $hostlabel=$_[2];print "LINE=".__LINE__."\n";
my $new_master=$_[3];print "LINE=".__LINE__."\n";
my $_connect=$_[4];print "LINE=".__LINE__."\n";
my $host_label=$hostlabel;print "LINE=".__LINE__."\n";
my $rcm_chain_link_num=-1;print "LINE=".__LINE__."\n";
if (-1<$#rcm_chain) {
$rcm_chain_link_num=shift @rcm_chain;print "LINE=".__LINE__."\n";
$host_label=
$Net::FullAuto::FA_Core::DeployRCM_Proxy[$rcm_chain_link_num];print "LINE=".__LINE__."\n";
} elsif (!$ftr_cmd) {
if (defined $Net::FullAuto::FA_Core::DeployRCM_Proxy[0]
&& $Net::FullAuto::FA_Core::DeployRCM_Proxy[0]) {
$rcm_chain_link_num=0;print "LINE=".__LINE__."\n";
$host_label=$Net::FullAuto::FA_Core::DeployRCM_Proxy[0];print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
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);print "LINE=".__LINE__."\n";
my $host= ($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
#print "IP=$ip and HOSTNAME=$hostname and HOST=$host\n";print "LINE=".__LINE__."\n";
if (!$login_id) {
if ($host eq
"$Net::FullAuto::FA_Core::Hosts{\"__Master_${$}__\"}{'HostName'}") {
print "FTR_RETURN2\n";print "LINE=".__LINE__."\n";
return Rem_Command::new('Rem_Command',$hostlabel,
$new_master,$_connect);print "LINE=".__LINE__."\n";
} elsif ($host eq
"$Net::FullAuto::FA_Core::Hosts{\"__Master_${$}__\"}{'IP'}") {
print "FTR_RETURN3\n";print "LINE=".__LINE__."\n";
return Rem_Command::new('Rem_Command',$ip,
$new_master,$_connect);print "LINE=".__LINE__."\n";
} else {
$login_id=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
}
} my $ftr_cmd_error='';my $su_scrub='';my $retrys='';print "LINE=".__LINE__."\n";
if ($ftr_cmd) {
#print "GOING TO TRY LOGIN=$login_id and IP=$ip and FTR_CMD=$ftr_cmd\n";print "LINE=".__LINE__."\n";
$ftr_cmd->{_cmd_handle}->print("telnet $host");print "LINE=".__LINE__."\n";
#print "GOING TO LOG IN TO $hostname - USERNAME=$login_id\n";<STDIN>;print "LINE=".__LINE__."\n";
my ($alloutput,$output,$cygwin)='';print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else { $su_id='' }
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=
'cygwin';print "LINE=".__LINE__."\n";
} elsif (-1<index $line,'AIX') {
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}='aix';print "LINE=".__LINE__."\n";
}
last if $line!~/Last login/i &&
$line=~/login[: ]*$|username[: ]*$/i;print "LINE=".__LINE__."\n";
}
while (1) {
eval {
$ftr_cmd->{_cmd_handle}->print($login_id);print "LINE=".__LINE__."\n";
## Wait for password prompt.
while (my $line=$ftr_cmd->{_cmd_handle}->get) {
last if $line=~/password[: ]*$/i;print "LINE=".__LINE__."\n";
}
## Send password.
my $recurse_passwd=
&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$login_id,'',$ftr_cmd_error);print "LINE=".__LINE__."\n";
$ftr_cmd->{_cmd_handle}->print($recurse_passwd);print "LINE=".__LINE__."\n";
my $alloutput='';my $output='';my $stderr='';print "LINE=".__LINE__."\n";
my $cygwin='';my $newpw='';print "LINE=".__LINE__."\n";
while (my $line=$ftr_cmd->{_cmd_handle}->get) {
($output=$line)=~s/login:.*//s;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($output)
if $line=~/(?<!Last )login[: ]*$/m;print "LINE=".__LINE__."\n";
if ($line=~/new password: ?$/is) {
$newpw=$line;last;print "LINE=".__LINE__."\n";
} last if $line=~/[$|%|>|#|-|:] ?$/s;print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::change_pw($ftr_cmd) if $newpw;print "LINE=".__LINE__."\n";
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
if ($su_scrub) {
my $kind='prod';print "LINE=".__LINE__."\n";
my $mr="__Master_".$$."__";print "LINE=".__LINE__."\n";
$kind='test' if $Net::FullAuto::FA_Core::test
&& !$Net::FullAuto::FA_Core::prod;print "LINE=".__LINE__."\n";
my $dbpath=$Net::FullAuto::FA_Core::Hosts{$mr}
{'FA_Secure'}.
${Net::FullAuto::FA_Core::progname}.
"_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{$mr}{'FA_Secure'}.'Passwds') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m.$Hosts{$mr}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Passwds/'.$Net::FullAuto::FA_Core::progname.
"_${kind}_passwds.db")) {
$mkdflag=1;print "LINE=".__LINE__."\n";
}
my $dbenv = BerkeleyDB::Env->new(
-Home =>
$Net::FullAuto::FA_Core::Hosts{$mr}{'FA_Secure'}.
'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL|DB_PRIVATE
) or &handle_error(
"cannot open environment for DB: ".
"$BerkeleyDB::Error\n",'',$track);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::acquire_fa_lock(9361);print "LINE=".__LINE__."\n";
my $pn=$Net::FullAuto::FA_Core::progname;print "LINE=".__LINE__."\n";
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${pn}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils(
'recover');print "LINE=".__LINE__."\n";
my $cmd="$d -h ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds';print "LINE=".__LINE__."\n";
my $out=`$cmd`;print "LINE=".__LINE__."\n";
&handle_error($out) if $out;print "LINE=".__LINE__."\n";
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${pn}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);print "LINE=".__LINE__."\n";
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${pn}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";print "LINE=".__LINE__."\n";
}
}
&handle_error(
"cannot open Btree for DB: ".
"$BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;print "LINE=".__LINE__."\n";
if ($^O eq 'cygwin') {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod').
"chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds/'.
$Net::FullAuto::FA_Core::progname.
"_${kind}_passwds.db";print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr &&
-1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $href='';print "LINE=".__LINE__."\n";
my $status=$bdb->db_get($host,$href);print "LINE=".__LINE__."\n";
$href=~s/\$HASH\d*\s*=\s*//s;print "LINE=".__LINE__."\n";
$href=eval $href;print "LINE=".__LINE__."\n";
my $key="${username}_X_${username}_X_${host}";print "LINE=".__LINE__."\n";
while (delete $href->{$key}) {}
my $cipher='';print "LINE=".__LINE__."\n";
#my $mr="__Master_${$}__";print "LINE=".__LINE__."\n";
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'});print "LINE=".__LINE__."\n";
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});print "LINE=".__LINE__."\n";
}
my $new_encrypted=$cipher->encrypt(
$recurse_passwd);print "LINE=".__LINE__."\n";
$href->{$key}=$new_encrypted;print "LINE=".__LINE__."\n";
my $put_href=Data::Dump::Streamer::Dump($href)->Out();print "LINE=".__LINE__."\n";
$status=$bdb->db_put($host,$put_href);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock(9361);print "LINE=".__LINE__."\n";
}
$ftr_cmd->{_cmd_handle}->cmd(
"export PS1='_funkyPrompt_';unset PROMPT_COMMAND");print "LINE=".__LINE__."\n";
$ftr_cmd->{_cmd_handle}->prompt("/_funkyPrompt_\$/");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftr_cmd);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
$ftr_cmd_error=$@;print "LINE=".__LINE__."\n";
print "FTR_CMD_ERROR=$ftr_cmd_error\n";<STDIN>;print "LINE=".__LINE__."\n";
$ftr_cmd_error=~s/^[\012|\015]*//s;print "LINE=".__LINE__."\n";
if ($ftr_cmd_error=~/invalid log|ogin incor/) {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$username);print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
}
next;print "LINE=".__LINE__."\n";
} elsif ($su_id &&
-1<index($ftr_cmd_error,'ation is d')) {
print "GOOD - SCRUBBING\n";print "LINE=".__LINE__."\n";
$su_scrub=
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$su_id);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
my $c_t=$ftr_cmd->{_cmd_type};$c_t=~s/^(.)/uc($1)/e;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} last;print "LINE=".__LINE__."\n";
}
$ftr_cmd->{_cmd_handle}->cmd(
"export PS1='_funkyPrompt_';unset PROMPT_COMMAND");print "LINE=".__LINE__."\n";
$ftr_cmd->{_cmd_handle}->prompt("/_funkyPrompt_\$/");print "LINE=".__LINE__."\n";
if ($hostlabel eq $host_label) {
print "FTR_RETURN4\n";print "LINE=".__LINE__."\n";
return $ftr_cmd;print "LINE=".__LINE__."\n";
} else {
print "FTR_RETURN4\n";print "LINE=".__LINE__."\n";
return &recurse_chain(\@rcm_map,$ftr_cmd,
$hostlabel,$_connect);print "LINE=".__LINE__."\n";
}
} elsif (&Net::FullAuto::FA_Core::ping($host)) {
$ftr_cmd = Rem_Command::new('Rem_Command',$host_label,
$new_master);print "LINE=".__LINE__."\n";
if ($hostlabel eq $host_label) {
print "FTR_RETURN5\n";print "LINE=".__LINE__."\n";
return $ftr_cmd;print "LINE=".__LINE__."\n";
} else {
print "FTR_RETURN6\n";print "LINE=".__LINE__."\n";
return &recurse_chain(\@rcm_map,$ftr_cmd,
$hostlabel,$_connect);print "LINE=".__LINE__."\n";
}
}
}
## End of &recurse_chain()
#print "CMD_TYPEBEFORERECURSE=$cmd_type\n";print "LINE=".__LINE__."\n";
$ftr_cmd=&recurse_chain($rcm_map,'',$hostlabel,$_connect);print "LINE=".__LINE__."\n";
#print "CMD_TYPEAFTERRECURSE=$cmd_type\n";<STDIN>;print "LINE=".__LINE__."\n";
#print "RECURSED HOSTNAME=",$ftr_cmd->cmd('hostname'),"\n";print "LINE=".__LINE__."\n";
}
}
print "WHAT ARE WE DOING HERE SO THAT THINGS WORK and FTM_TYPE=$ftm_type\n";<STDIN>;print "LINE=".__LINE__."\n";
if (!$ftr_cmd && ${$ftr_cnct}[0] eq 'smb' &&
-1<$#FA_Core::DeploySMB_Proxy) {
($ftr_cmd,$stderr)=
Rem_Command::new('Rem_Command',$hostlabel,
$new_master);print "LINE=".__LINE__."\n";
if ($stderr) {
chomp $stderr;print "LINE=".__LINE__."\n";
print "FTR_RETURN7\n";print "LINE=".__LINE__."\n";
return '','','','',$stderr;print "LINE=".__LINE__."\n";
}
$cmd_type=$ftr_cmd->{_cmd_type};print "LINE=".__LINE__."\n";
$ms_hostlabel=$hostlabel;print "LINE=".__LINE__."\n";
$ms_host=$host;print "LINE=".__LINE__."\n";
$ms_ms_share=$ms_share;print "LINE=".__LINE__."\n";
$ms_ms_domain=$ms_domain;print "LINE=".__LINE__."\n";
$ms_login_id=$login_id;print "LINE=".__LINE__."\n";
$ms_su_id=$su_id;print "LINE=".__LINE__."\n";
$ms_login_id=$su_id if $su_id;print "LINE=".__LINE__."\n";
($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]);print "LINE=".__LINE__."\n";
$host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
$login_id=&Net::FullAuto::FA_Core::username() if !$login_id;print "LINE=".__LINE__."\n";
$login_id=$su_id if $su_id;print "LINE=".__LINE__."\n";
$hostlabel=$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];print "LINE=".__LINE__."\n";
if (defined $transfer_dir && $transfer_dir) {
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftr_cmd,$cmd_type,'',$_connect);print "LINE=".__LINE__."\n";
${$work_dirs}{_cwd_mswin}=${$work_dirs}{_pre_mswin}
="\\\\$ms_host\\$ms_ms_share\\";print "LINE=".__LINE__."\n";
${$work_dirs}{_cwd}=${$work_dirs}{_pre}='';print "LINE=".__LINE__."\n";
my ($output,$stderr)=$ftr_cmd->cmd('cd '.${$work_dirs}{_tmp});print "LINE=".__LINE__."\n";
if ($stderr) {
@FA_Core::tran=();print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> ".${$work_dirs}{_tmp}
."\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-5');print "LINE=".__LINE__."\n";
}
($output,$stderr)=&ftpcmd($ftr_cmd,
'cd '.${$work_dirs}{_tmp},$cache);print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> $transfer_dir"
."\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-2') if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[0]=${$work_dirs}{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$ftr_cmd->{_ftp_handle}}{cd}=${$work_dirs}{_tmp};print "LINE=".__LINE__."\n";
} else {
# ADD CODE HERE FOR DYNAMIC TMP DIR DISCOVERY
&Net::FullAuto::FA_Core::handle_error("No TransferDir Defined for $hostlabel");print "LINE=".__LINE__."\n";
}
} return $work_dirs,$ftr_cmd,$cmd_type,$ftm_type,'';print "LINE=".__LINE__."\n";
}
sub ftm_login
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: File_Transfer::ftm_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $hostlabel=$_[0];print "LINE=".__LINE__."\n";
my $new_master=$_[1]||'';print "LINE=".__LINE__."\n";
my $_connect=$_[2]||'';print "LINE=".__LINE__."\n";
my $cache=$_[3]||'';print "LINE=".__LINE__."\n";
my $homedir='';print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
my @connect_method=@{$ftr_cnct};print "LINE=".__LINE__."\n";
my $host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG "NEWMASTER=$new_master<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$new_master && ($hostlabel eq "__Master_${$}__"
|| exists $Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel})) {
return "__Master_${$}__",'','','','','','','','';print "LINE=".__LINE__."\n";
}
my $ftp_handle='';my $ftr_cmd='';my $su_login='';print "LINE=".__LINE__."\n";
my $ftm_errmsg='';my $die='';my $s_err='';my $shell_pid=0;print "LINE=".__LINE__."\n";
my $retrys=0;my $local_transfer_dir='';my $cmd_type='';print "LINE=".__LINE__."\n";
my $ms_host='';my $ms_hostlabel='';my $fpx_handle='';print "LINE=".__LINE__."\n";
my $work_dirs={};my $die_login_id='';my $ftm_only=0;print "LINE=".__LINE__."\n";
my $ms_su_id='';my $ms_login_id='';my $smb_type='';print "LINE=".__LINE__."\n";
my $ms_ms_domain='';my $ms_ms_share='';my $ftm_type='';print "LINE=".__LINE__."\n";
my $desthostlabel='';my $p_uname='',my $fpx_passwd='';print "LINE=".__LINE__."\n";
my $ftm_passwd=$Net::FullAuto::FA_Core::dcipher->decrypt(
$Net::FullAuto::FA_Core::passetts->[0]);print "LINE=".__LINE__."\n";
my $ftp_pid='';my $fpx_pid='';my $smb=0;print "LINE=".__LINE__."\n";
my @errorstack=();print "LINE=".__LINE__."\n";
my ($output,$stdout,$stderr)=('','','');print "LINE=".__LINE__."\n";
$login_id=&Net::FullAuto::FA_Core::username() if !$login_id;print "LINE=".__LINE__."\n";
while (1) {
eval {
if (lc(${$ftr_cnct}[0]) eq 'smb') {
$smb=1;print "LINE=".__LINE__."\n";
$ms_hostlabel=$hostlabel;print "LINE=".__LINE__."\n";
$ms_host=$host;print "LINE=".__LINE__."\n";
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.";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
($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]);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;print "LINE=".__LINE__."\n";
}
$hostname||='';$ms_share||='';print "LINE=".__LINE__."\n";
$host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST1111=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$login_id=&Net::FullAuto::FA_Core::username() if !$login_id;print "LINE=".__LINE__."\n";
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],$su_id,
$ms_share,$ftm_errmsg,'','','smb');print "LINE=".__LINE__."\n";
if ($ftm_passwd ne 'DoNotSU!') {
$su_login=1;print "LINE=".__LINE__."\n";
} 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');print "LINE=".__LINE__."\n";
}
$ftm_errmsg='' unless defined $ftm_errmsg;
$hostlabel=$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];print "LINE=".__LINE__."\n";
@connect_method=@{$ftr_cnct};print "LINE=".__LINE__."\n";
} else {
($work_dirs,$smb_type,$stderr)=
&connect_share($Net::FullAuto::FA_Core::localhost->{_cmd_handle},
$hostlabel);print "LINE=".__LINE__."\n";
$cmd_type='';print "LINE=".__LINE__."\n";
$ftm_type='';print "LINE=".__LINE__."\n";
$smb=1;print "LINE=".__LINE__."\n";
if (!$stderr) {
${$work_dirs}{_tmp}=
$Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}=
$Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp_mswin};print "LINE=".__LINE__."\n";
${$work_dirs}{_pre_mswin}=${$work_dirs}{_cwd_mswin};print "LINE=".__LINE__."\n";
print "HOW ABOUT AN SMB UNAME???===$uname<===\n";<STDIN>;print "LINE=".__LINE__."\n";
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
);print "LINE=".__LINE__."\n";
$ftr_cmd=bless \%cmd, 'Rem_Command';print "LINE=".__LINE__."\n";
return '','',$work_dirs,$ftr_cmd,$ftm_type,
$cmd_type,$smb,'','','';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);print "LINE=".__LINE__."\n";
}
}
} 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;print "LINE=".__LINE__."\n";
$hostlabel=$Net::FullAuto::FA_Core::DeployFTM_Proxy[0];print "LINE=".__LINE__."\n";
($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);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;print "LINE=".__LINE__."\n";
}
$hostname||='';$ms_share||='';print "LINE=".__LINE__."\n";
$host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST2222=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::acquire_fa_lock(1234);print "LINE=".__LINE__."\n";
if ($su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$ftm_errmsg,'__su__',$ftm_type);print "LINE=".__LINE__."\n";
if ($fpx_passwd ne 'DoNotSU!') {
$su_login=1;print "LINE=".__LINE__."\n";
} else { $su_id='' }
}
if (!$su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'',$ftm_type);print "LINE=".__LINE__."\n";
}
my $sftploginid=($su_id)?$su_id:$login_id;print "LINE=".__LINE__."\n";
my $previous_method='';$stderr='';print "LINE=".__LINE__."\n";
my $fm_cnt=-1;print "LINE=".__LINE__."\n";
foreach my $connect_method (@connect_method) {
$fm_cnt++;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
} 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'};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftppath.='/'
if $Net::FullAuto::FA_Core::ftppath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $ftp__cmd=$Net::FullAuto::FA_Core::gbp->('ftp').
"ftp $host";print "LINE=".__LINE__."\n";
($fpx_handle,$fpx_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ftp')."ftp",$host,'',
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ftp subprocess");print "LINE=".__LINE__."\n";
$fpx_handle=Net::Telnet->new(Fhopen => $fpx_handle,
Timeout => $fttimeout);print "LINE=".__LINE__."\n";
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{'ftm_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'ftm_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];print "LINE=".__LINE__."\n";
}
$fpx_handle->telnetmode(0);print "LINE=".__LINE__."\n";
$fpx_handle->binmode(1);print "LINE=".__LINE__."\n";
$fpx_handle->output_record_separator("\r");print "LINE=".__LINE__."\n";
while (my $line=$fpx_handle->get) {
print "FTPLOGINLINE=$line and MS_SHARE=$ms_share\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "FTPLOGINLINE=$line and MS_SHARE=$ms_share\n";print "LINE=".__LINE__."\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";print "LINE=".__LINE__."\n";
last if $ln=~/_funkyPrompt_/s;print "LINE=".__LINE__."\n";
}
$line=~s/^(.*)?\n.*/$1/s;print "LINE=".__LINE__."\n";
$die=$line
."Destination Host - $host, HostLabel "
."- $hostlabel\n refused an "
."attempted connect operation.\n "
."Check for a running FTP daemon on "
."$hostlabel";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} last if $line=~/Name.*[: ]*$/i;print "LINE=".__LINE__."\n";
} $ftm_type='ftp';print "LINE=".__LINE__."\n";
} elsif (lc($connect_method) eq 'sftp') {
if (exists $Hosts{"__Master_${$}__"}{'sftp'}) {
$Net::FullAuto::FA_Core::sftppath=
$Hosts{"__Master_${$}__"}{'sftp'};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::sftppath.='/'
if $Net::FullAuto::FA_Core::sftppath!~/\/$/;print "LINE=".__LINE__."\n";
}
print "WHAT IS SLAVE=$Net::FullAuto::FA_Core::slave<==\n";print "LINE=".__LINE__."\n";
my $sshport='';my $idntfil='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
($fpx_handle,$fpx_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('sftp').'sftp',
"${sshport}$sftploginid\@$host",
'',$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch sftp subprocess");print "LINE=".__LINE__."\n";
$fpx_handle=Net::Telnet->new(Fhopen => $fpx_handle,
Timeout => $fttimeout);print "LINE=".__LINE__."\n";
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{'ftm_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'ftm_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];print "LINE=".__LINE__."\n";
}
$fpx_handle->telnetmode(0);print "LINE=".__LINE__."\n";
$fpx_handle->binmode(1);print "LINE=".__LINE__."\n";
$fpx_handle->output_record_separator("\r");print "LINE=".__LINE__."\n";
$ftm_type='sftp';print "LINE=".__LINE__."\n";
}
}
if ($su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$ftm_errmsg,'__su__',$ftm_type);print "LINE=".__LINE__."\n";
if ($fpx_passwd ne 'DoNotSU!') {
$su_login=1;print "LINE=".__LINE__."\n";
} else { $su_id='' }
}
if (!$su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'',$ftm_type);print "LINE=".__LINE__."\n";
}
## Wait for password prompt.
my $allines='';print "LINE=".__LINE__."\n";
while (my $line=$fpx_handle->get) {
print "SFTPLINE=$line<==\n";print "LINE=".__LINE__."\n";
$allines.=$line;print "LINE=".__LINE__."\n";
if ($allines=~/password[: ]+$/si) {
last;print "LINE=".__LINE__."\n";
} elsif ((-1<index($line,'530 '))
|| (-1<index($line,'421 '))) {
$line=~s/^(.*)?\n.*$/$1/s;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($line);print "LINE=".__LINE__."\n";
}
}
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 "LINE=".__LINE__."\n";
print "FPX_PID=$fpx_pid and TEL=$fpx_handle\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$fpx_passwd,$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$fpx_handle->prompt("/s*ftp> ?\$/");print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock(1234);print "LINE=".__LINE__."\n";
if (defined $transfer_dir && $transfer_dir) {
print "FTRFOUR\n";print "LINE=".__LINE__."\n";
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$fpx_handle,$ftm_type,'',$_connect);print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fpx_handle,
_hostlabel=>[ $hostlabel,'' ]
},'cd '.${$work_dirs}{_tmp});print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="The FTP Service Cannot cd to "
."TransferDir -> ".${$work_dirs}{_tmp}
."\n\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
} $ftp_handle=1;print "LINE=".__LINE__."\n";
my $ip='';my $hostname='';my $use='';my $ms_share='';print "LINE=".__LINE__."\n";
my $ms_domain='';my $cmd_cnct='';my $ftr_cnct='';print "LINE=".__LINE__."\n";
my $login_id='';my $su_id='';my $chmod='';print "LINE=".__LINE__."\n";
my $owner='';my $group='';my $transfer_dir='';print "LINE=".__LINE__."\n";
my $rcm_chain='';my $rcm_map='';my $p_uname='';print "LINE=".__LINE__."\n";
my $cmd_type='';print "LINE=".__LINE__."\n";
($ftp_handle,$stderr)=new Rem_Command($hostlabel,
$new_master,$_connect);print "LINE=".__LINE__."\n";
$shell_pid=$ftp_handle->{_sh_pid};print "LINE=".__LINE__."\n";
$ftp_pid=$ftp_handle->{_cmd_pid};print "LINE=".__LINE__."\n";
$cmd_type=$ftp_handle->{_cmd_type};print "LINE=".__LINE__."\n";
$ftp_handle=$ftp_handle->{_cmd_handle};print "LINE=".__LINE__."\n";
my $cygdrive=$ftp_handle->{_cygdrive};print "LINE=".__LINE__."\n";
$hostlabel=$desthostlabel;print "LINE=".__LINE__."\n";
($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);print "LINE=".__LINE__."\n";
my $sftploginid=($su_id)?$su_id:$login_id;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;print "LINE=".__LINE__."\n";
}
$ftp_handle->timeout($fttimeout);print "LINE=".__LINE__."\n";
$hostname||='';$ms_share||='';print "LINE=".__LINE__."\n";
$host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST3333=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $gotname=0;print "LINE=".__LINE__."\n";
my $previous_method='';$stderr='';print "LINE=".__LINE__."\n";
my $fm_cnt=-1;print "LINE=".__LINE__."\n";
CM1: foreach my $connect_method (@connect_method) {
# final dest via proxy
$fm_cnt++;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
} else { $previous_method=$connect_method;$stderr='' }
if (lc($connect_method) eq 'ftp') {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftp_handle);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
eval {
my $ftp__cmd=
$Net::FullAuto::FA_Core::gbp->('ftp')."ftp $host";print "LINE=".__LINE__."\n";
$ftp_handle->print($ftp__cmd);print "LINE=".__LINE__."\n";
my $allines='';print "LINE=".__LINE__."\n";
my $fc='';print "LINE=".__LINE__."\n";
my $al='';print "LINE=".__LINE__."\n";
my $cmdseen=0;print "LINE=".__LINE__."\n";
## Send Login ID.
ID: while (my $line=$ftp_handle->get) {
$line||='';print "LINE=".__LINE__."\n";
$line=~tr/\r//d;print "LINE=".__LINE__."\n";
$allines.=$line;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if (-1<index $allines,'_funkyPrompt_') {
$allines=~s/_funkyPrompt_//g;print "LINE=".__LINE__."\n";
my $fp='_funkyPrompt_';print "LINE=".__LINE__."\n";
my $stub=$line;print "LINE=".__LINE__."\n";
$stub=~/(^_fun*k*y*P*r*o*m*p*t*_*)/;print "LINE=".__LINE__."\n";
my $fs=$1;print "LINE=".__LINE__."\n";
$fs||='';print "LINE=".__LINE__."\n";
if (!$fs) {
$stub=~/(_*f*u*n*k*y*P*r*o*m*pt_$)/;print "LINE=".__LINE__."\n";
my $bs=$1;print "LINE=".__LINE__."\n";
$bs||='';print "LINE=".__LINE__."\n";
$line=~s/$bs$//s;print "LINE=".__LINE__."\n";
} else {
$line=~s/^$fs//s;print "LINE=".__LINE__."\n";
} $line=~s/^.*_funkyPrompt_//s;print "LINE=".__LINE__."\n";
}
if (!$cmdseen) {
next if $allines=~s/^\s$//s;print "LINE=".__LINE__."\n";
if (-1<index $ftp__cmd,$allines) {
next;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$fc=$ftp__cmd;print "LINE=".__LINE__."\n";
$fc=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$allines=~s/^\s*$fc\s*//s;print "LINE=".__LINE__."\n";
$cmdseen=1;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
if ($line=~/^$fc\s*/s) {
if ($line=~/^$fc\s*$/s) {
next;print "LINE=".__LINE__."\n";
} else {
$line=~s/^$fc\s*//s;print "LINE=".__LINE__."\n";
}
}
if ($line=~/^[^f].+\n/s && $line=~/ft?p?>? ?$/s) {
if ($line!~/ftp> $/s) {
$al=$line;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
} elsif ($line!~/^.*ftp> $/) {
if ($line=~/[.]\s*$/s) {
my $lline=$allines;print "LINE=".__LINE__."\n";
chomp($lline);print "LINE=".__LINE__."\n";
$lline=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
$line=$lline."\n";print "LINE=".__LINE__."\n";
} elsif ($allines=~/Name.*[: ]+$/si) {
if ($line=~/(.+)\n.+$/s) {
my $stub=$1;print "LINE=".__LINE__."\n";
my $tall=$allines;print "LINE=".__LINE__."\n";
$tall=~s/Name.*[: ]+$//si;print "LINE=".__LINE__."\n";
chomp($tall);print "LINE=".__LINE__."\n";
my $ll=$tall;print "LINE=".__LINE__."\n";
$ll=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
if (-1<index $ll, $stub) {
$line=$ll."\n";print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $line,'A remote host refused') {
$ftp_handle->cmd('bye');print "LINE=".__LINE__."\n";
$line=~s/\s*ftp> $//s;print "LINE=".__LINE__."\n";
die "$line";print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
my $tline=$line;print "LINE=".__LINE__."\n";
if (-1<index $allines,'Unknown host') {
$ftp_handle->cmd('bye');print "LINE=".__LINE__."\n";
die "ftp: connect: Unknown host";print "LINE=".__LINE__."\n";
}
if (-1<index $allines,'ftp: connect:') {
$allines=~/^.*connect:\s*(.*?)\n.*$/s;print "LINE=".__LINE__."\n";
my $m=$1;$m||='';print "LINE=".__LINE__."\n";
if ((-1==index $allines,'Address already in use')
&& (-1==index $allines,'Connection timed out')
&& (-1<index $allines,'Connection refused')) {
$ftp_handle->cmd('bye');print "LINE=".__LINE__."\n";
die "ftp: connect: $m";print "LINE=".__LINE__."\n";
} else {
$ftp_handle->close if defined fileno $ftp_handle;print "LINE=".__LINE__."\n";
sleep int $ftp_handle->timeout/3;print "LINE=".__LINE__."\n";
($ftp_handle,$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $ftp_pid=$ftp_handle->{_cmd_pid};print "LINE=".__LINE__."\n";
$cmd_type=$ftp_handle->{_cmd_type};print "LINE=".__LINE__."\n";
$ftp_handle=$ftp_handle->{_cmd_handle};print "LINE=".__LINE__."\n";
$ftp_handle->print(
$Net::FullAuto::FA_Core::gbp->('ftp').
"ftp $host");print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftm';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type}=$value;print "LINE=".__LINE__."\n";
last FH1;print "LINE=".__LINE__."\n";
}
}
}
}
}
} 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;print "LINE=".__LINE__."\n";
die "$allines\n $!";print "LINE=".__LINE__."\n";
}
$tline=~s/ftp> $//s;print "LINE=".__LINE__."\n";
print $tline if !$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (-1<index $allines,
'ftp: connect: Connection timed out') {
$allines=~s/s*ftp> ?\s*$//s;print "LINE=".__LINE__."\n";
die "$allines\n $!";print "LINE=".__LINE__."\n";
} elsif ((-1<index $allines,'A remote host refused')
|| (-1<index $allines,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
$allines=~s/^(.*)?\n.*/$1/s;print "LINE=".__LINE__."\n";
$die=$allines;print "LINE=".__LINE__."\n";
if ($die) {
$die.="Destination Host - $host, HostLabel "
."- $hostlabel\n refused an attempted "
."connect operation.\n Check for a "
."running FTP daemon on $hostlabel";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
if ($allines=~/Name.*[: ]+$/si) {
#$gotname=1;$ftr_cmd='ftp';last;print "LINE=".__LINE__."\n";
$gotname=1;last;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
print "WHAT IS THE FTP_EVAL_ERROR1111=$@\n";print "LINE=".__LINE__."\n";
if (!$gotname && ((-1==index $@,'Unknown host') &&
(-1==index $@,'Connection refused') &&
(-1==index $@,'A remote host refused'))) {
if (1<=$#connect_method) {
$stderr=$@;print "LINE=".__LINE__."\n";
next CM1;print "LINE=".__LINE__."\n";
}
$retrys++;next;print "LINE=".__LINE__."\n";
}
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]);print "LINE=".__LINE__."\n";
($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 "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
last FLP;print "LINE=".__LINE__."\n";
}
}
}
}
$ftp_handle->close;print "LINE=".__LINE__."\n";
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.";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} else { die $@ }
}
if ($su_id) {
$ftp_handle->print($su_id);print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print($login_id);print "LINE=".__LINE__."\n";
}
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftp_handle);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
$ftm_type='ftp';last;print "LINE=".__LINE__."\n";
} elsif (lc($connect_method) eq 'sftp') {
my $sshport='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
$ftp_handle->print($Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$sftploginid\@$host");print "LINE=".__LINE__."\n";
$ftm_type='sftp';print "LINE=".__LINE__."\n";
}
}
if ($su_id) {
my $value=$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"ftm_su_$Net::FullAuto::FA_Core::pcnt"}=$value;print "LINE=".__LINE__."\n";
} else {
my $value=$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"ftm_id_$Net::FullAuto::FA_Core::pcnt"}=$value;print "LINE=".__LINE__."\n";
}
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$ftm_errmsg,'__su__');print "LINE=".__LINE__."\n";
if ($ftm_passwd ne 'DoNotSU!') {
$ftp_handle->print($su_id);print "LINE=".__LINE__."\n";
$su_login=1;print "LINE=".__LINE__."\n";
} else { $su_id='' }
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg);print "LINE=".__LINE__."\n";
$ftp_handle->print($login_id);print "LINE=".__LINE__."\n";
}
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
);print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$ftm_passwd,$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$ftp_handle->prompt("/s*ftp> ?\$/");print "LINE=".__LINE__."\n";
if ($su_id) {
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$su_id"}=\%ftp;print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$login_id"}=\%ftp;print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
#$Net::FullAuto::FA_Core::pcnt++;print "LINE=".__LINE__."\n";
if (defined $transfer_dir && $transfer_dir) {
print "FTRFIVE\n";print "LINE=".__LINE__."\n";
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftp_handle,$ftm_type,$cygdrive,$_connect);print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ]
},'cd '.${$work_dirs}{_tmp});print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="The FTP Service Cannot cd to "
."TransferDir -> ".${$work_dirs}{_tmp}
."\n\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} $Net::FullAuto::FA_Core::ftpcwd{$ftp_handle}{cd}=
${$work_dirs}{_tmp};print "LINE=".__LINE__."\n";
}
my $ftmtype='';print "LINE=".__LINE__."\n";
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($hostlabel,$ftp_handle,
$new_master,$_connect,$cache)
if ($_connect ne 'connect_sftp' &&
$_connect ne 'connect_ftp');print "LINE=".__LINE__."\n";
$ftm_type=$ftmtype if $ftmtype;print "LINE=".__LINE__."\n";
print "RETURNTWO and FTR_CMD=$ftr_cmd\n";<STDIN>;print "LINE=".__LINE__."\n";
return $ftp_handle,$ftp_pid,$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,$fpx_handle,$fpx_pid,$die;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
} elsif (lc($connect_method) eq 'sftp') {
$ftm_type='sftp';last;print "LINE=".__LINE__."\n";
}
}
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$su_id,'',$ftm_errmsg,'__su__',$ftm_type);print "LINE=".__LINE__."\n";
if ($ftm_passwd ne 'DoNotSU!') {
$su_login=1;print "LINE=".__LINE__."\n";
} else { $su_id='' }
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$login_id,'',$ftm_errmsg,$ftm_type);print "LINE=".__LINE__."\n";
}
} my $peer=0;print "LINE=".__LINE__."\n";
while ($peer++<2) {
($ftp_handle,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master,$_connect);print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else { last }
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$ftp_pid=$ftp_handle->{_cmd_pid};print "LINE=".__LINE__."\n";
$shell_pid=$ftp_handle->{_sh_pid};print "LINE=".__LINE__."\n";
$cmd_type=$ftp_handle->{_cmd_type};print "LINE=".__LINE__."\n";
$ftp_handle=$ftp_handle->{_cmd_handle};print "LINE=".__LINE__."\n";
$ftp_handle->timeout($fttimeout);print "LINE=".__LINE__."\n";
my $previous_method='';$stderr='';print "LINE=".__LINE__."\n";
my $fm_cnt=-1;my $key_authentication=0;print "LINE=".__LINE__."\n";
CM2: foreach my $connect_method (@connect_method) {
$fm_cnt++;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "\n".$stderr."\n"
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet);print "LINE=".__LINE__."\n";
} else { $previous_method=$connect_method;$stderr='' }
if (lc($connect_method) eq 'ftp') {
my $ftp__cmd=$Net::FullAuto::FA_Core::gbp->('ftp')."ftp $host";print "LINE=".__LINE__."\n";
$ftp_handle->print($ftp__cmd);print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftm';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type}=
$value;print "LINE=".__LINE__."\n";
last FH;print "LINE=".__LINE__."\n";
}
}
}
}
## 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";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n Logging into $host ($hostlabel) via ".
"$connect_method . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (2) into $host ($hostlabel) ",
"via $connect_method . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n Logging (2) into $host ($hostlabel) ".
"via $connect_method . . .\n\n"])
if $cache;print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
$s_err=' ';print "LINE=".__LINE__."\n";
my $gotname=0;print "LINE=".__LINE__."\n";
while (1) {
eval {
my $allines='';print "LINE=".__LINE__."\n";
my $fc='';print "LINE=".__LINE__."\n";
my $al='';print "LINE=".__LINE__."\n";
my $cmdseen=0;print "LINE=".__LINE__."\n";
## Send Login ID.
$ftp_handle->autoflush(1);print "LINE=".__LINE__."\n";
ID: while (my $line=$ftp_handle->get) {
$line||='';print "LINE=".__LINE__."\n";
$line=~tr/\r//d;print "LINE=".__LINE__."\n";
$allines.=$line;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if (-1<index $allines,'_funkyPrompt_') {
$allines=~s/_funkyPrompt_//g;print "LINE=".__LINE__."\n";
my $fp='_funkyPrompt_';print "LINE=".__LINE__."\n";
my $stub=$line;print "LINE=".__LINE__."\n";
$stub=~/(^_fun*k*y*P*r*o*m*p*t*_*)/;print "LINE=".__LINE__."\n";
my $fs=$1;print "LINE=".__LINE__."\n";
$fs||='';print "LINE=".__LINE__."\n";
if (!$fs) {
$stub=~/(_*f*u*n*k*y*P*r*o*m*pt_$)/;print "LINE=".__LINE__."\n";
my $bs=$1;print "LINE=".__LINE__."\n";
$bs||='';print "LINE=".__LINE__."\n";
$line=~s/$bs$//s;print "LINE=".__LINE__."\n";
} else {
$line=~s/^$fs//s;print "LINE=".__LINE__."\n";
} $line=~s/^.*_funkyPrompt_//s;print "LINE=".__LINE__."\n";
}
if (!$cmdseen) {
next if $allines=~s/^\s$//s;print "LINE=".__LINE__."\n";
if (-1<index $ftp__cmd,$allines) {
next;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$fc=$ftp__cmd;print "LINE=".__LINE__."\n";
$fc=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$allines=~s/^\s*$fc\s*//s;print "LINE=".__LINE__."\n";
$cmdseen=1;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
if ($line=~/^$fc\s*/s) {
if ($line=~/^$fc\s*$/s) {
next;print "LINE=".__LINE__."\n";
} else {
$line=~s/^$fc\s*//s;print "LINE=".__LINE__."\n";
}
}
if ($line=~/^[^f].+\n/s && $line=~/ft?p?>? ?$/s) {
if ($line!~/ftp> $/s) {
$al=$line;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
} elsif ($line!~/^.*ftp> $/) {
if ($line=~/[.]\s*$/s) {
my $lline=$allines;print "LINE=".__LINE__."\n";
chomp($lline);print "LINE=".__LINE__."\n";
$lline=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
$line=$lline."\n";print "LINE=".__LINE__."\n";
} elsif ($allines=~/Name.*[: ]+$/si) {
if ($line=~/(.+)\n.+$/s) {
my $stub=$1;print "LINE=".__LINE__."\n";
my $tall=$allines;print "LINE=".__LINE__."\n";
$tall=~s/Name.*[: ]+$//si;print "LINE=".__LINE__."\n";
chomp($tall);print "LINE=".__LINE__."\n";
my $ll=$tall;print "LINE=".__LINE__."\n";
$ll=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
if (-1<index $ll, $stub) {
$line=$ll."\n";print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index $line,'A remote host refused') {
$ftp_handle->cmd('bye');print "LINE=".__LINE__."\n";
$line=~s/\s*ftp> $//s;print "LINE=".__LINE__."\n";
die $line;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
my $tline=$line;print "LINE=".__LINE__."\n";
if (-1<index $allines,'Unknown host') {
$ftp_handle->cmd('bye');print "LINE=".__LINE__."\n";
die "ftp: connect: Unknown host";print "LINE=".__LINE__."\n";
}
if (-1<index $allines,'ftp: connect:') {
$allines=~/^.*connect:\s*(.*?)\n.*$/s;print "LINE=".__LINE__."\n";
my $m=$1;$m||='';print "LINE=".__LINE__."\n";
if ((-1==index $allines,'Address already in use')
&& (-1==index $allines,'Connection timed out')
&& (-1<index $allines,'Connection refused')) {
$ftp_handle->cmd('bye');print "LINE=".__LINE__."\n";
die "ftp: connect: $m";print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print "FTP_PID=$ftp_pid<== and ==>$localhost->{_cmd_pid}<==\n";print "LINE=".__LINE__."\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};print "LINE=".__LINE__."\n";
$ftp_handle->close if defined fileno $ftp_handle;print "LINE=".__LINE__."\n";
sleep int $ftp_handle->timeout/3;print "LINE=".__LINE__."\n";
($ftp_handle,$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master,$_connect);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$ftp_handle=$ftp_handle->{_cmd_handle};print "LINE=".__LINE__."\n";
$ftp_handle->timeout($fttimeout);print "LINE=".__LINE__."\n";
my $sftploginid=($su_id)?$su_id:$login_id;print "LINE=".__LINE__."\n";
my $previous_method='';$stderr='';print "LINE=".__LINE__."\n";
my $fm_cnt=-1;print "LINE=".__LINE__."\n";
my $ftp__cmd=
$Net::FullAuto::FA_Core::gbp->('ftp').
"ftp $host";print "LINE=".__LINE__."\n";
foreach $connect_method (@connect_method) {
if (lc($connect_method) eq 'ftp') {
$ftp_handle->print(
$Net::FullAuto::FA_Core::gbp->('ftp').
"ftp $host");print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif (lc($connect_method) eq 'sftp') {
my $sshport='';print "LINE=".__LINE__."\n";
if (exists
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
$ftp_handle->print(
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$sftploginid\@$host");print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
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};print "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftm';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}=$value;print "LINE=".__LINE__."\n";
last FH1;print "LINE=".__LINE__."\n";
}
}
}
}
} 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 "LINE=".__LINE__."\n";
print "FTP_PID=$ftp_pid\n";print "LINE=".__LINE__."\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};print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
"ftp: connect: $m\n "
."$retrys Attempts Tried",'-8','__cleanup__');print "LINE=".__LINE__."\n";
}
} 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;print "LINE=".__LINE__."\n";
die "$allines\n $!";print "LINE=".__LINE__."\n";
}
$tline=~s/ftp> $//s;print "LINE=".__LINE__."\n";
print $tline if !$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (-1<index $allines,
'ftp: connect: Connection timed out') {
$allines=~s/s*ftp> ?\s*$//s;print "LINE=".__LINE__."\n";
die "$allines\n $!";print "LINE=".__LINE__."\n";
} elsif ((-1<index $allines,'A remote host refused')
|| (-1<index $allines,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST4444=$host\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($ms_share && !$ftm_only) {
if ($^O eq 'cygwin') {
my $mswin_cwd='';print "LINE=".__LINE__."\n";
($mswin_cwd,$smb_type,$stderr)=
&connect_share(
$Net::FullAuto::FA_Core::localhost->
{_cmd_handle},
$hostlabel);print "LINE=".__LINE__."\n";
$cmd_type='';print "LINE=".__LINE__."\n";
$ftm_type='';print "LINE=".__LINE__."\n";
$smb=1;print "LINE=".__LINE__."\n";
if (!$stderr) {
${$work_dirs}{_tmp}=
$Net::FullAuto::FA_Core::localhost->
{'_work_dirs'}->{_tmp};print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}=
$Net::FullAuto::FA_Core::localhost->
{'_work_dirs'}->{_tmp_mswin};print "LINE=".__LINE__."\n";
${$work_dirs}{_pre_mswin}
=${$work_dirs}{_cwd_mswin};print "LINE=".__LINE__."\n";
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
);print "LINE=".__LINE__."\n";
$ftr_cmd=bless \%cmd, 'Rem_Command';print "LINE=".__LINE__."\n";
print "RETURNTHREE and FTR_CMD=$ftr_cmd\n";<STDIN>;print "LINE=".__LINE__."\n";
return '','',$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,'','','';print "LINE=".__LINE__."\n";
} elsif (unpack('a10',$stderr) eq 'System err'
&& $stderr=~/unknown user name/s) {
&Net::FullAuto::FA_Core::handle_error(
$stderr);print "LINE=".__LINE__."\n";
} 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'}='';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Hosts{$hostname}
{'FTM_Link'}='smb';print "LINE=".__LINE__."\n";
$ms_host=$host;print "LINE=".__LINE__."\n";
$ms_ms_share=$ms_share;print "LINE=".__LINE__."\n";
$ms_hostlabel=$hostlabel;print "LINE=".__LINE__."\n";
$ms_login_id=$login_id;print "LINE=".__LINE__."\n";
$ms_su_id=$su_id;print "LINE=".__LINE__."\n";
$hostlabel=
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];print "LINE=".__LINE__."\n";
($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]);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X')
{
$fttimeout=
$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;print "LINE=".__LINE__."\n";
}
$host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST5555=$host\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$login_id=&Net::FullAuto::FA_Core::username()
if !$login_id;print "LINE=".__LINE__."\n";
$login_id=$su_id if $su_id;print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
$ftr_cmd=
$Net::FullAuto::FA_Core::Connections{
$Net::FullAuto::FA_Core::DeploySMB_Proxy
[0]."__%-$login_id"};print "LINE=".__LINE__."\n";
$cmd_type=$ftr_cmd->{_cmd_type};print "LINE=".__LINE__."\n";
$ftm_type=$ftp_handle->{_ftm_type};print "LINE=".__LINE__."\n";
$smb=1;print "LINE=".__LINE__."\n";
$uname=
$Net::FullAuto::FA_Core::Connections{
$Net::FullAuto::FA_Core::DeploySMB_Proxy
[0]."__%-$login_id"}->{_uname};print "LINE=".__LINE__."\n";
my $mswin_cwd='';print "LINE=".__LINE__."\n";
($work_dirs,$smb_type,$stderr)=
&connect_share($ftr_cmd,$ms_hostlabel);print "LINE=".__LINE__."\n";
if (defined $transfer_dir
&& $transfer_dir) {
if (unpack('@1 a1',$transfer_dir)
eq ':') {
my ($drive,$path)=
unpack('a1 x1 a*',$transfer_dir);print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp_mswin}
=$transfer_dir.'\\';print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
${$work_dirs}{_tmp}
=$ftr_cmd->{_cygdrive}
.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
} 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);print "LINE=".__LINE__."\n";
}
}
if ($stderr) {
$die="Could Not Map the Directory "
."Share\n -> \"\\\\$host"
."\\$ms_share\"\n\n $stderr";print "LINE=".__LINE__."\n";
my $er=$!;print "LINE=".__LINE__."\n";
if ($er=~s/is not /is not\n /) {
$er=" $er";print "LINE=".__LINE__."\n";
} $die="$die\n $er";print "LINE=".__LINE__."\n";
}
print "RETURNFOUR and FTR_CMD=$ftr_cmd\n";<STDIN>;print "LINE=".__LINE__."\n";
return '','',$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,$smb,'','',$die;print "LINE=".__LINE__."\n";
} else {
$ftm_passwd=
&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy
[0],$login_id,$ms_share,$ftm_errmsg,'',
$ftm_type); #BRAD
$ftp_handle->print('bye');print "LINE=".__LINE__."\n";
$ftp_handle->get;print "LINE=".__LINE__."\n";
$ftp_handle->timeout($fttimeout);print "LINE=".__LINE__."\n";
my $sftploginid=($su_id)?$su_id:$login_id;print "LINE=".__LINE__."\n";
my $ftp__cmd=
$Net::FullAuto::FA_Core::gbp->('ftp').
"ftp $host";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
foreach $connect_method (@{$ftr_cnct}) {
if (lc($connect_method) eq 'ftp') {
$ftp_handle->print(
$Net::FullAuto::FA_Core::gbp->(
'ftp')."ftp $host");print "LINE=".__LINE__."\n";
$ftm_type='ftp';print "LINE=".__LINE__."\n";
} elsif (lc($connect_method) eq 'sftp') {
my $sshport='';print "LINE=".__LINE__."\n";
if (exists
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
my $s='sftp';print "LINE=".__LINE__."\n";
$ftp_handle->print(
$Net::FullAuto::FA_Core::gbp->($s).
'sftp '.
"${sshport}$sftploginid\@$host");print "LINE=".__LINE__."\n";
$ftm_type='sftp';print "LINE=".__LINE__."\n";
}
}
} $smb=1;print "LINE=".__LINE__."\n";
## 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;print "LINE=".__LINE__."\n";
$die=$line;last;print "LINE=".__LINE__."\n";
}
if ($line=~/Name.*[: ]*$/i) {
$gotname=1;last ID;print "LINE=".__LINE__."\n";
}
}
} else {
$allines=~s/^(.*)?\n.*/$1/s;print "LINE=".__LINE__."\n";
$die=$allines;print "LINE=".__LINE__."\n";
}
} else {
$allines=~s/^(.*)?\n.*/$1/s;print "LINE=".__LINE__."\n";
$die=$allines;print "LINE=".__LINE__."\n";
}
#print "NOWWWLINE=$line AND DIE=$die<==\n";print "LINE=".__LINE__."\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";print "LINE=".__LINE__."\n";
#&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
die $die;print "LINE=".__LINE__."\n";
}
}
if ($allines=~/Name.*[: ]+$/si) {
#$gotname=1;$ftr_cmd='ftp';last;print "LINE=".__LINE__."\n";
$gotname=1;last;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
#print "WHAT IS THE FTP_EVAL_ERROR2222=$@ and GOTNAME\n";print "LINE=".__LINE__."\n";
if (!$gotname && ((-1==index $@,'Unknown host') &&
(-1==index $@,'Connection refused') &&
(-1==index $@,'A remote host refused'))) {
if (1<=$#connect_method) {
$stderr=$@;print "LINE=".__LINE__."\n";
next CM2;print "LINE=".__LINE__."\n";
}
$retrys++;next;print "LINE=".__LINE__."\n";
}
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.";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,
'__cleanup__');print "LINE=".__LINE__."\n";
} else {
print $Net::FullAuto::FA_Core::MRLOG
"ftplogin() EVALERROR=$@<==\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
die $@;print "LINE=".__LINE__."\n";
}
} last
}
if ($su_id) {
$ftp_handle->print($su_id);print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print($login_id);print "LINE=".__LINE__."\n";
}
## Wait for password prompt.
($key_authentication,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
$ftm_type='ftp';last;print "LINE=".__LINE__."\n";
} elsif (lc($connect_method) eq 'sftp') {
my $sftploginid=($su_id)?$su_id:$login_id;print "LINE=".__LINE__."\n";
my $sshport='';print "LINE=".__LINE__."\n";
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
#####4444444
$ftp_handle->print($Net::FullAuto::FA_Core::gbp->('sftp').
'sftp '."${sshport}$sftploginid\@$host");print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftm';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type}=
$value;print "LINE=".__LINE__."\n";
last FH;print "LINE=".__LINE__."\n";
}
}
}
}
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";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n Logging into $host ($hostlabel) via ".
"$connect_method . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (3) into $host ($hostlabel) via ",
"$connect_method . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},
[0,"\n Logging (3) into $host ($hostlabel) via ".
"$connect_method . . .\n\n"])
if $cache;print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
## Wait for password prompt.
($key_authentication,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
},$timeout);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print STDERR $stderr."\n";print "LINE=".__LINE__."\n";
}
die $stderr;print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print('bye');print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
$ftm_type='sftp';last;print "LINE=".__LINE__."\n";
}
}
## Send password.
$ftp_handle->print($ftm_passwd) unless $key_authentication;print "LINE=".__LINE__."\n";
my $lin='';my $asked=0;my $authyes=0;my @choices=();print "LINE=".__LINE__."\n";
while (1) {
while (my $line=$ftp_handle->get(Timeout=>$fttimeout)) {
if ($line=~/command not found/) {
die 'Permssion Denied';print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$lin.=$line;print "LINE=".__LINE__."\n";
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='';print "LINE=".__LINE__."\n";
($error=$lin)=~s/^\s*(.*)\n.*$/$1/s;print "LINE=".__LINE__."\n";
if ($error=~/^\s*[Pp]assword[:\s]+$/s) {
$error='Password *NOT* accepted';print "LINE=".__LINE__."\n";
}
$error||='Password *NOT* accepted';print "LINE=".__LINE__."\n";
my $asktimeout=300;my $a='';my $choice='';print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # NB:
# \n required
alarm $asktimeout;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
$choices[0]=
"Re-enter password and re-attempt with "
."\'$su_id\'";print "LINE=".__LINE__."\n";
$choices[1]=
"Attempt login with base id \'$login_id\'";print "LINE=".__LINE__."\n";
$choice=&Term::Menus::pick(\@choices,$banner);print "LINE=".__LINE__."\n";
chomp $choice;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
$choice||=']quit[';print "LINE=".__LINE__."\n";
if ($choice ne ']quit[') {
if ($choice=~/$su_id/s) {
my $passwd_timeout=350;print "LINE=".__LINE__."\n";
my $te_time=time;print "LINE=".__LINE__."\n";
my $show='';my $save_passwd='';print "LINE=".__LINE__."\n";
($show=$lin)=~s/^.*?\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);print "LINE=".__LINE__."\n";
&acquire_fa_lock(9854);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
$show=~s/:\s*$//s;print "LINE=".__LINE__."\n";
print "\n$show (5): ";print "LINE=".__LINE__."\n";
} else {
print "\n$show ";print "LINE=".__LINE__."\n";
}
Term::ReadKey::ReadMode 2;print "LINE=".__LINE__."\n";
$save_passwd=<STDIN>;print "LINE=".__LINE__."\n";
Term::ReadKey::ReadMode 0;print "LINE=".__LINE__."\n";
&release_fa_lock(9854);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@ eq "alarm\n") {
print "\n\n";print "LINE=".__LINE__."\n";
my $errmsg.="\n\n Time Allowed for ".
"Password Input has Expired.\n";print "LINE=".__LINE__."\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq
'notify_on_error') {
my $body='';print "LINE=".__LINE__."\n";
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
$body="\n ERROR MESSAGE (6) "
."-> $errmsg";print "LINE=".__LINE__."\n";
} else {
$body="\n ERROR MESSAGE -> "
.$errmsg;print "LINE=".__LINE__."\n";
}
}
$body.=$show;my $subject='';print "LINE=".__LINE__."\n";
if ($host) {
$subject="Login Failed for $su_id ".
"on $host";print "LINE=".__LINE__."\n";
} else {
$subject="Authentication Failed";print "LINE=".__LINE__."\n";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::send_email(
\%mail);print "LINE=".__LINE__."\n";
}
&handle_error(
"Time Allowed for Password Input ".
"has Expired.",'__cleanup__');print "LINE=".__LINE__."\n";
}
chomp $save_passwd;print "LINE=".__LINE__."\n";
$ftp_handle->print($save_passwd);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $show
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$lin='';print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print("\003");print "LINE=".__LINE__."\n";
$ftp_handle->print;print "LINE=".__LINE__."\n";
while (my $line=$ftp_handle->get) {
print "TRYING TO USE NEW PASSWORDLINE=$line<==\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "LLINE44=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$line=~s/\s*$//s;print "LINE=".__LINE__."\n";
last if $line=~/_funkyPrompt_$/s;print "LINE=".__LINE__."\n";
last if $line=~/Killed by signal 2\.$/s;print "LINE=".__LINE__."\n";
} $lin='';print "LINE=".__LINE__."\n";
my $sshport='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::su_scrub(
$hostlabel,$su_id,$ftm_type);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::passwd_db_update(
$hostlabel,$su_id,'DoNotSU!',
$ftm_type,$sshport);print "LINE=".__LINE__."\n";
$ftp_handle->print(
$Net::FullAuto::FA_Core::gbp->('sftp').
'sftp '."${sshport}$login_id\@$host");print "LINE=".__LINE__."\n";
## Wait for password prompt.
($key_authentication,$stderr)=
&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&clean_filehandle($ftp_handle);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
## Send password.
print "111 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";print "LINE=".__LINE__."\n";
my $ftm_passwd=
&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');print "LINE=".__LINE__."\n";
print "PASSWORDNOW=$ftm_passwd\n";print "LINE=".__LINE__."\n";
$ftp_handle->print($ftm_passwd);print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host (".
"$hostlabel) ",
"via $ftm_type . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print
"\n Logging (4) into $host (",
"$hostlabel) ",
"via $ftm_type . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging (4) into $host (".
"$hostlabel) ",
"via $ftm_type . . .\n\n"])
if $cache;print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} else {
&Net::FullAuto::FA_Core::cleanup();print "LINE=".__LINE__."\n";
}
} elsif ($asked<4) {
print "YESSSSSSS WE HAVE DONE IT FOUR TIMES11\n";<STDIN>;print "LINE=".__LINE__."\n";
}
} else {
## Send password.
my $showerr='';print "LINE=".__LINE__."\n";
($showerr=$lin)=~s/^.*?\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
$showerr=~s/^(.*)?\n.*$/$1/s;print "LINE=".__LINE__."\n";
$retrys++;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
}
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$showerr,'','sftp','__force__');print "LINE=".__LINE__."\n";
$ftp_handle->print($ftm_passwd);print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostlabel) ".
"via $ftm_type . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print
"\n Logging (5) into $host ($hostlabel) ",
"via $ftm_type . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,"\n ".
"Logging (5) into $host ($hostlabel) ".
"via $ftm_type . . .\n\n"])
if $cache;print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
$lin='';next;print "LINE=".__LINE__."\n";
}
} elsif ($line=~/_funkyPrompt_$|Connection closed/s) {
my $sshport='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
$ftp_handle->print(
$Net::FullAuto::FA_Core::gbp->('sftp').'sftp '.
"${sshport}$login_id\@$host");print "LINE=".__LINE__."\n";
## Wait for password prompt.
($key_authentication,$stderr)=
&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;print "LINE=".__LINE__."\n";
} else {
$ftp_handle->print("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&clean_filehandle($ftp_handle);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
## 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,'*';print "LINE=".__LINE__."\n";
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');print "LINE=".__LINE__."\n";
$ftp_handle->print($ftm_passwd);print "LINE=".__LINE__."\n";
my $showsftp="\n LoggingF into "
."$host via sftp . . .\n\n";print "LINE=".__LINE__."\n";
print $showsftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $showsftp
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
print "AUTHENHERE!1111\n";<STDIN>;print "LINE=".__LINE__."\n";
my $question=$lin;print "LINE=".__LINE__."\n";
$question=~s/^.*(The authen.*)$/$1/s;print "LINE=".__LINE__."\n";
$question=~s/\' can\'t/\'\ncan\'t/s;print "LINE=".__LINE__."\n";
while (1) {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n$question ";print "LINE=".__LINE__."\n";
my $answer=<STDIN>;print "LINE=".__LINE__."\n";
chomp $answer;print "LINE=".__LINE__."\n";
if (lc($answer) eq 'yes') {
$ftp_handle->print($answer);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$authyes=1;$lin='';last;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::cleanup()
}
}
} elsif ($lin=~/channel is being closed/s) {
$lin=~s/\s*//s;print "LINE=".__LINE__."\n";
$lin=~s/^(.*)?\n.*$/$1/s;print "LINE=".__LINE__."\n";
my $warning=$lin;print "LINE=".__LINE__."\n";
$warning=~tr/\015//d;print "LINE=".__LINE__."\n";
$warning=~s/^/ /gm;print "LINE=".__LINE__."\n";
$warning="WARNING! - sftp on Host $host is not configured\n"
." for user $login_id :\n\n$warning";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$warning,'__return__','__warn__');print "LINE=".__LINE__."\n";
die $lin;print "LINE=".__LINE__."\n";
} elsif ($line=~/^530 /m) {
$line=~s/^.*(530.*)/$1/s;print "LINE=".__LINE__."\n";
$line=~s/\s*ftp\>\s*$//s;print "LINE=".__LINE__."\n";
$line=~s/\n/\n /s;print "LINE=".__LINE__."\n";
die "$line\n";print "LINE=".__LINE__."\n";
}
if ($line=~/[\$\%\>\#\-\:]+ ?$/m) {
$lin='';last;print "LINE=".__LINE__."\n";
} elsif ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
$lin='';last;print "LINE=".__LINE__."\n";
} elsif ($lin=~/Perm/s && $lin=~/password[: ]+$/si) { last }
}
if ($lin=~/Perm/s) {
$lin=~s/\s*//s;print "LINE=".__LINE__."\n";
$lin=~s/^(.*)?\n.*$/$1/s;print "LINE=".__LINE__."\n";
die "$lin\n";print "LINE=".__LINE__."\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
);print "LINE=".__LINE__."\n";
# Make sure prompt won't match anything in send data.
$ftp_handle->prompt("/s*ftp> ?\$/");print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'pwd',$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $rwd='Remote working directory:';print "LINE=".__LINE__."\n";
my $icd=' is the current directory';print "LINE=".__LINE__."\n";
($homedir=$output)=~s/^(?:257 ["]|$rwd\s+)(.*)?(?:["]$icd)*$/$1/s;print "LINE=".__LINE__."\n";
if ($_connect ne 'connect_sftp' && $_connect ne 'connect_ftp') {
my $ftmtype='';print "LINE=".__LINE__."\n";
if ($ms_hostlabel) {
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($ms_hostlabel,$ftp_handle,
$new_master,$_connect,$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1','__cleanup__')
if $stderr;print "LINE=".__LINE__."\n";
$ftm_type=$ftmtype if $ftmtype;print "LINE=".__LINE__."\n";
if ($su_id) {
$Net::FullAuto::FA_Core::Connections
{"${hostlabel}__%-$su_id"}=$ftr_cmd;print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::Connections
{"${hostlabel}__%-$login_id"}=$ftr_cmd;print "LINE=".__LINE__."\n";
}
} else {
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($hostlabel,$ftp_handle,
$new_master,$_connect,$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$ftm_type=$ftmtype if $ftmtype;print "LINE=".__LINE__."\n";
}
}
#$ftp_handle->print("quote stat");print "LINE=".__LINE__."\n";
#while ($line=$ftp_handle->get) {
# print "FTPLINE2=$line\n";print "LINE=".__LINE__."\n";
# last if $line=~/ftp>\s*/s;print "LINE=".__LINE__."\n";
#};<STDIN>;print "LINE=".__LINE__."\n";
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}\"",$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="The FTP Service Cannot Change to "
."the Transfer Directory"
."\n\n -> $stderr\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} $Net::FullAuto::FA_Core::ftpcwd{$ftp_handle}{cd}=
${$work_dirs}{_tmp};print "LINE=".__LINE__."\n";
}
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}\"",
$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="The FTP Service Cannot Change to "
."the Local Transfer Directory"
."\n\n -> $stderr\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::ftpcwd{$ftp_handle}{lcd}=
$Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
if ($@) {
$ftm_errmsg=$@;print "LINE=".__LINE__."\n";
#print "FTM_LOGIN_ERRMSG=$ftm_errmsg and FTM_PID=$ftp_pid and SHELLPID=$shell_pid<===\n";print "LINE=".__LINE__."\n";
print "sub ftm_login FTM_LOGIN_ERROR=$ftm_errmsg<==\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"HOSTTEST6666=$host\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$ftm_errmsg="$@\n While Attempting "
."Login to $host\n -> HostLabel "
."\'$hostlabel\'\n\n";print "LINE=".__LINE__."\n";
if (unpack('a4',$ftm_errmsg) eq 'read') {
$ftm_errmsg.=" Current Timeout "
."Setting is -> " . $ftp_handle->timeout
." seconds.\n\n";print "LINE=".__LINE__."\n";
}
if ($retrys<2 && unpack('a4',$ftm_errmsg) eq 'read') {
$retrys++;print "LINE=".__LINE__."\n";
warn "$ftm_errmsg $!";print "LINE=".__LINE__."\n";
if (defined fileno $ftp_handle) {
$ftp_handle->print; # if defined fileno $ftp_handle;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "File_Transfer::ftm_login() LOOKING FOR PROMPT=$line\n and ERROR=$@\n";print "LINE=".__LINE__."\n";
if ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
return $ftp_handle,$ftp_pid,$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,$smb,'','',$die;print "LINE=".__LINE__."\n";
} elsif ($line=~
/logout|Connection.*closed|A remote host refused/s) {
last;print "LINE=".__LINE__."\n";
}
}
}
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};print "LINE=".__LINE__."\n";
last FTH;print "LINE=".__LINE__."\n";
}
}
}
}
$ftp_handle->close;print "LINE=".__LINE__."\n";
if ($hostlabel eq $Net::FullAuto::FA_Core::DeploySMB_Proxy[0]
&& 1<$#FA_Core::DeploySMB_Proxy) {
shift @FA_Core::DeploySMB_Proxy;print "LINE=".__LINE__."\n";
# DO MORE WORK ON SWITCHING DEPLOYPROXYS
$ftm_errmsg.="COULD HAVE WORKED WITH NEW CODE SWITCHING DPRX.";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($ftm_errmsg);print "LINE=".__LINE__."\n";
} elsif ($ftm_errmsg=~/421 Service/s ||
$ftm_errmsg=~/Connection closed/s) {
&Net::FullAuto::FA_Core::handle_error("$ftm_errmsg$s_err");print "LINE=".__LINE__."\n";
}
next;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$die=$ftm_errmsg;print "LINE=".__LINE__."\n";
$ftp_handle=Bad_Handle->new($hostlabel,$die);print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
$die_login_id=($su_login)?$su_id:$login_id;print "LINE=".__LINE__."\n";
if ($retrys<2 &&
(-1==index $ftm_errmsg,'No more authentication methods')) {
if ($ftm_errmsg=~/530 |Perm|(channel is being closed)/) {
my $shipht=$1;print "LINE=".__LINE__."\n";
shift @connect_method if $shipht;print "LINE=".__LINE__."\n";
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);print "LINE=".__LINE__."\n";
}
$retrys++;print "LINE=".__LINE__."\n";
$retrys=0 if $shipht;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$ftp_handle->print("\003");print "LINE=".__LINE__."\n";
$ftp_handle->get;print "LINE=".__LINE__."\n";
$ftp_handle->print('bye');print "LINE=".__LINE__."\n";
while (my $line=$ftp_handle->get) {
last if $line=~/_funkyPrompt_|221 Goodbye/s;print "LINE=".__LINE__."\n";
}
($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 "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::localhost{_cmd_pid}||='';print "LINE=".__LINE__."\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};print "LINE=".__LINE__."\n";
$ftp_handle->close;print "LINE=".__LINE__."\n";
if (-1<$#connect_method && ($shipht ||
!$Net::FullAuto::FA_Core::cron)) {
next;print "LINE=".__LINE__."\n";
}
} 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);print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);print "LINE=".__LINE__."\n";
} $retrys++;next if !$Net::FullAuto::FA_Core::cron;print "LINE=".__LINE__."\n";
}
} else { shift @connect_method;next if $#connect_method }
if (unpack('a10',$ftm_errmsg) eq 'The System') {
$die="$ftm_errmsg$s_err";print "LINE=".__LINE__."\n";
} else {
my $f_t=$ftm_type;$f_t=~s/^(.)/uc($1)/e;print "LINE=".__LINE__."\n";
$ftm_errmsg=~s/^(.*)\n *(.*)$/$1\n $2/s;print "LINE=".__LINE__."\n";
$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 ";print "LINE=".__LINE__."\n";
} last;print "LINE=".__LINE__."\n";
} else { last }
last if $die;print "LINE=".__LINE__."\n";
} return $ftp_handle,$ftp_pid,$work_dirs,$homedir,$ftr_cmd,
$ftm_type,$cmd_type,$smb,'','',$die;print "LINE=".__LINE__."\n";
} ## END of &ftm_login
sub wait_for_passwd_prompt
{
## Wait for password prompt.
my @topcaller=caller;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $filehandle=$_[0];print "LINE=".__LINE__."\n";
my $timeout=$_[1]||$Net::FullAuto::FA_Core::timeout;print "LINE=".__LINE__."\n";
my $notnew=$_[2]||'';print "LINE=".__LINE__."\n";
my $lin='';my $authyes=0;my $gotpass=0;my $warning='';print "LINE=".__LINE__."\n";
my $eval_stdout='';my $eval_stderr='';$@='';print "LINE=".__LINE__."\n";
my $connect_err=0;my $count=0;print "LINE=".__LINE__."\n";
$filehandle->{_cmd_handle}->autoflush(1);print "LINE=".__LINE__."\n";
my $starttime=time;my $firstflag=0;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
$lin.=$line;print "LINE=".__LINE__."\n";
if (!$notnew && !$firstflag && 5<=time()-$starttime) {
$firstflag=1;print "LINE=".__LINE__."\n";
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.";print "LINE=".__LINE__."\n";
}
}
if (-1<index $line,'Permission denied') {
alarm 0;print "LINE=".__LINE__."\n";
die 'Permission denied';print "LINE=".__LINE__."\n";
} elsif ($line=~/sftp>\s*$/s) {
return 'key_authenticated','';print "LINE=".__LINE__."\n";
} elsif ($warning || (-1<index $line,'@@@@@@@@@@')) {
$warning.=$line;print "LINE=".__LINE__."\n";
$count++ if $line=~/^\s*$/s;print "LINE=".__LINE__."\n";
if ($warning=~/Connection closed|Connection reset/s
|| $count==10) {
$warning=~s/^.*?(\@+.*)$/$1/s;print "LINE=".__LINE__."\n";
$warning=~s/_funkyPrompt_//s;print "LINE=".__LINE__."\n";
$warning=~s/^/ /gm;print "LINE=".__LINE__."\n";
$warning=~s/\s*$//s;print "LINE=".__LINE__."\n";
die "\n".$warning;print "LINE=".__LINE__."\n";
} $filehandle->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} elsif (-1<index $lin,'Address already in use') {
alarm 0;print "LINE=".__LINE__."\n";
die 'Connection closed';print "LINE=".__LINE__."\n";
} elsif (-1< index $lin,'Write failed: Broken pipe') {
die "read timed-out\n";print "LINE=".__LINE__."\n";
#} elsif (-1<index $lin,'No route to host') {
# alarm 0;print "LINE=".__LINE__."\n";
# die $lin;print "LINE=".__LINE__."\n";
} elsif (-1<index $lin,'Connection reset by peer') {
alarm 0;print "LINE=".__LINE__."\n";
if ($lin=~s/^.*(ssh:.*)$/$1/s) {
$lin=~s/Could/ Could/s;print "LINE=".__LINE__."\n";
$lin=~s/_funkyPrompt_//s;print "LINE=".__LINE__."\n";
die $lin;print "LINE=".__LINE__."\n";
} else {
$lin='Connection closed';print "LINE=".__LINE__."\n";
}
die $lin;print "LINE=".__LINE__."\n";
} elsif (7<length $line && unpack('a8',$line) eq 'Insecure') {
$line=~s/^Insecure/INSECURE/s;print "LINE=".__LINE__."\n";
$eval_stdout='';$eval_stderr=$line;print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
die $line;print "LINE=".__LINE__."\n";
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
my $question=$lin;print "LINE=".__LINE__."\n";
$question=~s/^.*(The authen.*)$/$1/s;print "LINE=".__LINE__."\n";
$question=~s/\' can\'t/\'\ncan\'t/s;print "LINE=".__LINE__."\n";
while (1) {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n$question ";print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
my $authtimeout=120;my $a='';print "LINE=".__LINE__."\n";
my $answer='';print "LINE=".__LINE__."\n";
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $authtimeout;print "LINE=".__LINE__."\n";
$answer=<STDIN>;print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
&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,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::cleanup()
}
chomp $answer;print "LINE=".__LINE__."\n";
if (lc($answer) eq 'yes' or $authorize_connect) {
$filehandle->{_cmd_handle}->print('yes');print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$authyes=1;$lin='';print "LINE=".__LINE__."\n";
$SIG{ALRM} = sub { die "read timed-out:do_slave\n" };print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
&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,'*';print "LINE=".__LINE__."\n";
$gotpass=1;alarm 0;last PW;print "LINE=".__LINE__."\n";
} 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);print "LINE=".__LINE__."\n";
my $fulllin=$lin;print "LINE=".__LINE__."\n";
$lin=~/(^530[ ].*$)|(^421[ ].*$)
|(^Connection[ ]refused.*$)
|(^Connection[ ]closed.*$)
|(^ssh:[ ]Could[ ]not.*)/xm;print "LINE=".__LINE__."\n";
$lin=$1 if $1;$lin=$2 if $2;print "LINE=".__LINE__."\n";
$lin=$3 if $3;$lin=$4 if $4;print "LINE=".__LINE__."\n";
$lin=$5 if $5;print "LINE=".__LINE__."\n";
if (-1<index $lin,'Connection refused') {
alarm 0;print "LINE=".__LINE__."\n";
die 'Connection refused';print "LINE=".__LINE__."\n";
} elsif (-1<index $lin,'name not known') {
alarm 0;print "LINE=".__LINE__."\n";
die $lin;print "LINE=".__LINE__."\n";
} elsif (-1<index $lin,'Connection closed') {
alarm 0;print "LINE=".__LINE__."\n";
if ($line=~/(_fu?n?k?y?P?r?o?m?p?t?_*$)/) {
$fulllin=~s/_fu?n?k?y?P?r?o?m?p?t?_*//s;print "LINE=".__LINE__."\n";
$fulllin=~s/^(.*?)\n(.*)/$2/s;print "LINE=".__LINE__."\n";
my $fcmd=$1;print "LINE=".__LINE__."\n";
$fulllin.="\n HINT: Be sure you can run COMMAND:\n"
."\n $fcmd\n\n successfully outside of "
."FullAuto\n"
." before running FullAuto again.\n\n ";print "LINE=".__LINE__."\n";
die $fulllin;print "LINE=".__LINE__."\n";
}
die $lin;print "LINE=".__LINE__."\n";
} elsif (-1<index $lin,'Could not create') {
alarm 0;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
die $eval_stderr;print "LINE=".__LINE__."\n";
}
$eval_stdout='';$eval_stderr=$lin;print "LINE=".__LINE__."\n";
die $eval_stderr;print "LINE=".__LINE__."\n";
} else {
$eval_stdout='';$eval_stderr=$lin;print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
die $eval_stderr;print "LINE=".__LINE__."\n";
}
}
if ($lin=~/Warning/s) {
$lin=~s/^.*(Warning.*)$/$1/s;print "LINE=".__LINE__."\n";
print "\n$lin";sleep 1;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
}
} alarm 0;print "LINE=".__LINE__."\n";
last if $gotpass;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
if ($@) {
if (wantarray) {
my $error=$@;print "LINE=".__LINE__."\n";
if ($@=~/Permission denied/) {
#print "do_slave ONE and ERROR=$error\n";print "LINE=".__LINE__."\n";
return ('','read timed-out:do_slave')
} elsif ($@!~/Connection closed/ &&
(-1==index $@, 'name not known')) {
my $err=$@;print "LINE=".__LINE__."\n";
eval {
$filehandle->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
my $cnt=0;print "LINE=".__LINE__."\n";
while (my $line=$filehandle->{_cmd_handle}->get) {
last if $line=~/_funkyPrompt_/s;print "LINE=".__LINE__."\n";
$filehandle->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
last if $cnt++==10;print "LINE=".__LINE__."\n";
}
if ($cnt==11 and (-1<index $err,'read timed-out')
&& !$slave) {
#print "do_slave TWO and ERROR=$error\n";print "LINE=".__LINE__."\n";
$error='read timed-out:do_slave';print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
if ($error eq 'read timed-out:do_slave') {
#print "do_slave THREE and ERROR=$error\n";print "LINE=".__LINE__."\n";
return ('','read timed-out:do_slave')
}
} return '', $error;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} elsif (wantarray) {
return $eval_stdout,$eval_stderr;print "LINE=".__LINE__."\n";
} elsif ($eval_stderr) {
&Net::FullAuto::FA_Core::handle_error($@);print "LINE=".__LINE__."\n";
} else {
return $eval_stdout;print "LINE=".__LINE__."\n";
}
} ## END of &wait_for_passwd_prompt
sub connect_share
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "File_Transfer::connect_share() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my (@outlines,@errlines)=();print "LINE=".__LINE__."\n";
my $cmd_handle=$_[0];print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $_connect=$_[2]||'';print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
my ($output,$stdout,$stderr)=('','','');print "LINE=".__LINE__."\n";
my $cnct_passwd='';print "LINE=".__LINE__."\n";
my $host=($use eq 'ip')?$ip:$hostname;
my $smb_type='';print "LINE=".__LINE__."\n";
#print "THISSS=net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1";print "LINE=".__LINE__."\n";
my @output=$cmd_handle->cmd(
"net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1");print "LINE=".__LINE__."\n";
#print "OUTPUT=@output and CMDHANDLE=$cmd_handle\n";print "LINE=".__LINE__."\n";
for (@output) {
push @{ s/stdout: // ? \@outlines : \@errlines }, $_;print "LINE=".__LINE__."\n";
} $stdout=join '', @outlines;print "LINE=".__LINE__."\n";
$stderr=join '',@errlines;@output=();print "LINE=".__LINE__."\n";
if ($stdout) {
if ($stdout=~/^Samba/m) {
$smb_type='Samba';print "LINE=".__LINE__."\n";
} else {
$smb_type='cygwin';print "LINE=".__LINE__."\n";
}
my $ms_cnct='net use \\\\'.$host.'\\'.$ms_share;print "LINE=".__LINE__."\n";
$login_id=$su_id if $su_id;print "LINE=".__LINE__."\n";
my $dom='';print "LINE=".__LINE__."\n";
if ($ms_domain) {
$dom=$ms_domain.'\\';print "LINE=".__LINE__."\n";
} else {
if (($host=~tr/.//)==2) {
$dom=substr($host,0,(index $host,'.')) . '\\';print "LINE=".__LINE__."\n";
} else {
$dom=$host.'//';print "LINE=".__LINE__."\n";
}
}
if ($su_id) {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
'','__su__');print "LINE=".__LINE__."\n";
} else {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,$ms_share,'');print "LINE=".__LINE__."\n";
}
while (1) {
my $ms_cmd="$ms_cnct $cnct_passwd /USER:$dom"
.$login_id;print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },$ms_cmd);print "LINE=".__LINE__."\n";
if (!$stderr ||
(-1<index $stderr,'credentials supplied conflict')) {
return "\\\\$host\\$ms_share\\",$smb_type,'';print "LINE=".__LINE__."\n";
} elsif (-1<index $stderr,'Logon failure') {
if ($su_id) {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$stderr,'__force__','__su__');print "LINE=".__LINE__."\n";
} else {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,$ms_share,
$stderr,'__force__');print "LINE=".__LINE__."\n";
}
} else {
$stderr="From Command :\n\n $ms_cmd\n\n "
."$stderr\n $!";print "LINE=".__LINE__."\n";
return '','',$stderr;print "LINE=".__LINE__."\n";
}
}
} else {
$stderr=~s/^/ /mg;print "LINE=".__LINE__."\n";
$stderr=~s/\s*//;print "LINE=".__LINE__."\n";
$stderr="From Command :\n\n "
."net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1"
."\n\n$stderr\n $!";print "LINE=".__LINE__."\n";
return '','',$stderr;print "LINE=".__LINE__."\n";
}
}
sub cwd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: File_Transfer::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
my $target_dir=$_[1];print "LINE=".__LINE__."\n";
my $cache=$_[2]||'';print "LINE=".__LINE__."\n";
$target_dir||='';print "LINE=".__LINE__."\n";
$target_dir=~s/[\/\\]*$//
if $target_dir ne '/' && $target_dir ne '\\';print "LINE=".__LINE__."\n";
my $len_tdir=length $target_dir;print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
if (unpack('a1',$target_dir) eq '.') {
if ($target_dir eq '.') {
if (wantarray) {
return '\'.\' is Current Directory','';print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
}
}
#print "TARGET_DIR=$target_dir\n";print "LINE=".__LINE__."\n";
my $hostlabel=$self->{_hostlabel}->[0]||$self->{_hostlabel}->[1];print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
my $host=($use eq 'ip')?$ip:$hostname;print "LINE=".__LINE__."\n";
if (!$target_dir) {
my @caller=caller;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} 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.','';print "LINE=".__LINE__."\n";
} else { return 'CWD command successful.' }
} elsif ($target_dir eq '-' || $target_dir eq '~'
|| $target_dir eq '..') {
if ($self->{_work_dirs}->{_pre}) {
my $chdir='';print "LINE=".__LINE__."\n";
if ($target_dir eq '-') {
$chdir=$self->{_work_dirs}->{_pre};print "LINE=".__LINE__."\n";
} elsif ($target_dir ne '..') {
$chdir=$self->{_homedir};print "LINE=".__LINE__."\n";
} else { $chdir=$target_dir }
if (exists $self->{_cmd_handle} && $self->{_cmd_handle}) {
($output,$stderr)=$self->{_cmd_handle}->cmd("cd $chdir");print "LINE=".__LINE__."\n";
}
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="\n\n --> $target_dir\n\n"
." DOES NOT EXIST!: $!";print "LINE=".__LINE__."\n";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die,'-7') }
}
if ($self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftm_type =>$self->{_ftm_type} },
"cd \"$chdir\"",$cache);print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
}
my $save_pre=$self->{_work_dirs}->{_pre};print "LINE=".__LINE__."\n";
if ($chdir eq '..') {
$self->{_work_dirs}->{_pre}=
$self->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
if ($self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftm_type =>$self->{_ftm_type} },
"pwd",$cache);print "LINE=".__LINE__."\n";
$output=~s/Remote working directory: (.*)/$1/;print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_cwd}=$output;print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
} elsif (exists $self->{_cmd_handle} && $self->{_cmd_handle}) {
($output,$stderr)=$self->cmd("pwd");print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_cwd}=$output;print "LINE=".__LINE__."\n";
}
} else {
$self->{_work_dirs}->{_pre}=
$self->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
if ($target_dir eq '-') {
$self->{_work_dirs}->{_cwd}=$save_pre;print "LINE=".__LINE__."\n";
} else {
$self->{_work_dirs}->{_cwd}=
$self->{_homedir};print "LINE=".__LINE__."\n";
}
}
if (wantarray) {
return 'CWD command successful.','';print "LINE=".__LINE__."\n";
} else { return 'CWD command successful.' }
#$self->{_work_dirs}->{_pre_mswin}=
# $self->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
#$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';print "LINE=".__LINE__."\n";
} elsif (wantarray) {
return 'CWD command successful.','';print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
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='';print "LINE=".__LINE__."\n";
if ($td) {
if ($td=~/^[\/\\][^:]/) {
if ($ms_share) {
if (($tar_dir=$target_dir)=~s/\//\\/g) {
$tar_dir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
}
$tar_dir="\\\\$host\\$ms_share$tar_dir";print "LINE=".__LINE__."\n";
} else {
my $die='Cannot Determine Root -or- Drive -or- Share'
."\n for Directory $target_dir";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
}
$tar_dir=$self->{_work_dirs}->{_cwd_mswin}.$tar_dir;print "LINE=".__LINE__."\n";
} else {
my $die='Cannot Determine Root -or- Drive -or- Share'
."\n for Directory $target_dir";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} else {
$tar_dir=$target_dir;print "LINE=".__LINE__."\n";
}
my @output=();my $cnt=0;print "LINE=".__LINE__."\n";
while (1) {
($output,$stderr)=$self->{_cmd_handle}->
cmd("cmd /c dir /-C \"$tar_dir\"");print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if (!$stderr && substr($output,-12,-2) ne 'bytes free') {
$output='';next unless $cnt++;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} else { last }
}
my $outdir='';print "LINE=".__LINE__."\n";
($outdir=$output)=~s/^.*Directory of ([^\n]*).*$/$1/s;print "LINE=".__LINE__."\n";
$outdir=~tr/\0-\37\177-\377//d;
if ($outdir eq $tar_dir) {
$self->{_work_dirs}->{_pre_mswin}=
$self->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';print "LINE=".__LINE__."\n";
$output="CWD command successful";print "LINE=".__LINE__."\n";
} else {
$output=~s/^.*Directory of [^\n]*(.*)$/$1/s;print "LINE=".__LINE__."\n";
my $leaf=substr($tar_dir,(rindex $tar_dir,"\\")+1);print "LINE=".__LINE__."\n";
foreach my $line (split /\n/, $output) {
$line=~tr/\0-\37\177-\377//d;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\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";print "LINE=".__LINE__."\n";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif ($target_dir=~/^([^~.\/\\][^:])/) {
$target_dir=~s/\\/\//g;print "LINE=".__LINE__."\n";
if (exists $self->{_work_dirs}->{_cwd}) {
$self->{_work_dirs}->{_pre}=
$self->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
$target_dir=$self->{_work_dirs}->{_cwd}.'/'.$target_dir.'/';print "LINE=".__LINE__."\n";
} else {
$self->{_work_dirs}->{_pre}=$self->{_homedir};print "LINE=".__LINE__."\n";
$target_dir=$self->{_homedir}.'/'.$target_dir.'/';print "LINE=".__LINE__."\n";
}
if (exists $self->{_cmd_handle} && $self->{_cmd_handle}) {
($output,$stderr)=$self->{_cmd_handle}->
cmd("cd $target_dir");print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
}
my $phost=$hostlabel;print "LINE=".__LINE__."\n";
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!: $!";print "LINE=".__LINE__."\n";
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},
_hostlabel=>[ $hostlabel,'' ],
_ftm_type =>$self->{_ftm_type} },
"cd \"$target_dir\"",$cache);print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
}
$self->{_work_dirs}->{_cwd}=$target_dir;print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_pre_mswin}=
$self->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';print "LINE=".__LINE__."\n";
} elsif ($self->{_uname} eq 'cygwin' &&
$target_dir=~/^[A-Za-z]:/) {
my ($drive,$path)=unpack('a1 x1 a*',$target_dir);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
my $tar_dir=$self->{_cygdrive}.'/'.lc($drive).$path;print "LINE=".__LINE__."\n";
($output,$stderr)=$self->cmd("cd \"$tar_dir\"");print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return $output,$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);print "LINE=".__LINE__."\n";
}
}
if ($self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftm_type =>$self->{_ftm_type} },
"cd \"$tar_dir\"",$cache);print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
}
#$self->{_work_dirs}->{_pre}=$self->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
#$self->{_work_dirs}->{_pre_mswin}=
# $self->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
#$self->{_work_dirs}->{_cwd}=$tar_dir.'/';print "LINE=".__LINE__."\n";
#$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';print "LINE=".__LINE__."\n";
} 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},
_hostlabel=>[ $hostlabel,'' ],
_ftm_type =>$self->{_ftm_type} },
'cd \'..\'',$cache);print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
}
($output,$stderr)=$self->cmd('cd \'..\'');print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
} 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 "LINE=".__LINE__."\n";
print "WHAT IS EXISTS=",exists $self->{_cmd_handle}->{_work_dirs},"\n";print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
print "WHAT IS REFNOW=",ref $self->{_cmd_handle}->{_work_dirs},"\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if (exists $self->{_work_dirs}->{_cwd}) {
$target_dir=$self->{_work_dirs}->{_cwd}
="$self->{_work_dirs}->{_cwd}/$target_dir/";print "LINE=".__LINE__."\n";
} else {
$target_dir=$self->{_work_dirs}->{_cwd_mswin}
="$self->{_work_dirs}->{_cwd_mswin}\\$target_dir\\";print "LINE=".__LINE__."\n";
}
}
if (exists $self->{_smb} && $ms_share &&
$target_dir=~/^[\/\\][^\/\\]/ &&
$target_dir!~/$self->{_cygdrive_regex}/) {
my $tdir=$target_dir;print "LINE=".__LINE__."\n";
$tdir=~s/^[\/|\\]+//;print "LINE=".__LINE__."\n";
$tdir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$tdir="\\\\$host\\$ms_share\\$tdir";print "LINE=".__LINE__."\n";
my $t_dir=$tdir;print "LINE=".__LINE__."\n";
$t_dir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
$tdir=~s/[\\]*$//;print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_cwd_mswin}=$tdir.'\\';print "LINE=".__LINE__."\n";
}
$output='CWD command successful';print "LINE=".__LINE__."\n";
return $output,'';print "LINE=".__LINE__."\n";
} else {
if (wantarray) {
return '',"Cannot locate $target_dir";print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"Cannot locate $target_dir");print "LINE=".__LINE__."\n";
}
}
} elsif ((exists $self->{_ftm_type}) &&
$self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=
&Rem_Command::ftpcmd($self,
"cd \"$target_dir\"",$cache);print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
$Net::FullAuto::FA_Core::ftpcwd{$self->{_ftp_handle}}{cd}
=$target_dir;print "LINE=".__LINE__."\n";
}
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')) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});print "LINE=".__LINE__."\n";
if ($cfh_error) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});print "LINE=".__LINE__."\n";
if ($cfh_error) {
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-3');print "LINE=".__LINE__."\n";
}
}
($output,$stderr)=$self->cmd("cd \'$target_dir\'");print "LINE=".__LINE__."\n";
$stderr=$output if -1<index $output,"Couldn't can";print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else {
$self->{_work_dirs}->{_pre}=$self->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
if (exists $self->{_work_dirs}->{_pre_mswin}) {
$self->{_work_dirs}->{_pre_mswin}
=$self->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
my $tdir='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::cygpathw{$target_dir}) {
$tdir=$Net::FullAuto::FA_Core::cygpathw{$target_dir};print "LINE=".__LINE__."\n";
} else {
($tdir,$stderr)=$self->cmd("cygpath -w \"$target_dir\"");print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-4');print "LINE=".__LINE__."\n";
}
}
$tdir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$target_dir}=$tdir;
};print "LINE=".__LINE__."\n";
$self->{_work_dirs}->{_cwd_mswin}=$tdir.'\\\\';print "LINE=".__LINE__."\n";
}
$self->{_work_dirs}->{_cwd}=$target_dir.'/';print "LINE=".__LINE__."\n";
$output='CWD command successful'
}
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
chomp($@);print "LINE=".__LINE__."\n";
if (-1<index $@,"Transfer Directory") {
if (wantarray) {
return '', $@;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} else {
my $die=$@;print "LINE=".__LINE__."\n";
#$die=~s/\.$//s;print "LINE=".__LINE__."\n";
$die=~s/( line.*)[.]$/\n $1/s;print "LINE=".__LINE__."\n";
if ($hostlabel=~/Master/) {
$hostlabel='localhost';print "LINE=".__LINE__."\n";
}
$die.=" on Host $hostlabel\n";print "LINE=".__LINE__."\n";
my $cnt='';my $hnames='';print "LINE=".__LINE__."\n";
foreach my $host (@{$self->{_hostlabel}}) {
next if !$cnt++;print "LINE=".__LINE__."\n";
next if !$host;print "LINE=".__LINE__."\n";
$hnames.="\'$host\', ";print "LINE=".__LINE__."\n";
} substr($hnames,-2)='';print "LINE=".__LINE__."\n";
$die.=" (Host also has Labels - $hnames)\n"
if $hnames;print "LINE=".__LINE__."\n";
if (wantarray) {
return '', "$die";print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif (wantarray) {
return $output,'';print "LINE=".__LINE__."\n";
} else {
return $output;print "LINE=".__LINE__."\n";
}
}
sub pwd
{
my ($self) = @_;print "LINE=".__LINE__."\n";
if ($self->{_work_dirs}->{_cwd}) {
return $self->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
} else {
my $pwd=join '',$self->{"_$self->{_ftm_type}_handle"}->cmd('pwd');print "LINE=".__LINE__."\n";
chomp $pwd;return $pwd;print "LINE=".__LINE__."\n";
}
}
sub tmp
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my $path=$_[1];print "LINE=".__LINE__."\n";
$path||='';print "LINE=".__LINE__."\n";
my $token=$_[2];print "LINE=".__LINE__."\n";
$token||='';print "LINE=".__LINE__."\n";
my ($output,$stderr)=('','');print "LINE=".__LINE__."\n";
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");print "LINE=".__LINE__."\n";
}
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
}
my $tdir='tmp'.$self->{_cmd_pid}.'_'
.$Net::FullAuto::FA_Core::invoked[0].'_'
.$Net::FullAuto::FA_Core::increment++;print "LINE=".__LINE__."\n";
push @{$Net::FullAuto::FA_Core::tmp_files_dirs{$self->{_cmd_handle}}},
[ $self->{_work_dirs}->{_tmp},$tdir ];print "LINE=".__LINE__."\n";
my $return_path='';print "LINE=".__LINE__."\n";
if ($token) {
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
$path=~s/\//\\/g;print "LINE=".__LINE__."\n";
$path=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
($output,$stderr)=$self->cmd($Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m.$self->{_work_dirs}->{_tmp}.'/'.$tdir);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
$return_path=$self->{_work_dirs}->{_tmp_mswin}
.$tdir.'\\'.$path;print "LINE=".__LINE__."\n";
} else {
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
($output,$stderr)=$self->cmd($Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir '.$m.$self->{_work_dirs}->{_tmp}.'/'.$tdir);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
$return_path=$self->{_work_dirs}->{_tmp}.$tdir.'/'.$path;print "LINE=".__LINE__."\n";
} return $return_path, $self->{_work_dirs}->{_tmp}.$tdir;print "LINE=".__LINE__."\n";
}
sub diff
{
push @_, '_diff';print "LINE=".__LINE__."\n";
return &mirror(@_);print "LINE=".__LINE__."\n";
}
sub mirror
{
my $_diff=0;print "LINE=".__LINE__."\n";
if ($_[$#_] eq '_diff') {
pop @_;print "LINE=".__LINE__."\n";
$_diff=1;print "LINE=".__LINE__."\n";
}
my ($baseFH, %args) = @_;print "LINE=".__LINE__."\n";
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.";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
my $username=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
my $dest_output='';my $base_output='';my $lsgnu=0;print "LINE=".__LINE__."\n";
my $num_of_levels='';my $mirrormap='';my $trantar='';print "LINE=".__LINE__."\n";
my $trandir='';my $chk_id='';my $local_transfer_dir='';print "LINE=".__LINE__."\n";
my $destFH={};my $bprxFH='';my $dprxFH='';print "LINE=".__LINE__."\n";
my $sub=(caller(1))[3];$sub=~s/\s*FA_Core::/&/;print "LINE=".__LINE__."\n";
my $caller='';my $cline='';my $mirror_output='';print "LINE=".__LINE__."\n";
my $debug_info='';$deploy_info='';my $dir='';print "LINE=".__LINE__."\n";
my $mirror_debug='';my $excluded='';print "LINE=".__LINE__."\n";
my $base_unzip_path='';my $dest_unzip_path='';print "LINE=".__LINE__."\n";
my $base_zip_path='';my $tarlistmpdir='';print "LINE=".__LINE__."\n";
my ($output,$stdout,$stderr)=('','','');print "LINE=".__LINE__."\n";
$args{ZipBDir}||='';print "LINE=".__LINE__."\n";
$args{ZipDDir}||='';print "LINE=".__LINE__."\n";
if (!exists $args{Cache} || !$args{Cache} && $main::cache) {
$args{Cache}=$main::cache;print "LINE=".__LINE__."\n";
}
$args{Cache}||='';print "LINE=".__LINE__."\n";
my $cache=$args{Cache};print "LINE=".__LINE__."\n";
print "WHAT IS CACHE=$cache\n" if $cache;print "LINE=".__LINE__."\n";
print "KEYS=",(join " | ",keys %{$cache}),"\n" if $cache;print "LINE=".__LINE__."\n";
#print $Net::FullAuto::FA_Core::MRLOG "CACHEEEEEEEEEEEEEEEEEEEEEEEEEE=",$cache->{'key'},"\n";print "LINE=".__LINE__."\n";
($caller,$cline)=(caller)[1,2];print "LINE=".__LINE__."\n";
if (ref $args{DestHost} eq 'ARRAY') {
@dhostlabels=@{$args{DestHost}};print "LINE=".__LINE__."\n";
} elsif (4<length $args{DestHost} && unpack('a5',$args{DestHost})
eq 'ARRAY') {
&Net::FullAuto::FA_Core::handle_error(
"quotes improperly surround destination hostlabel(s) arg");print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} else {
last;print "LINE=".__LINE__."\n";
}
}
my $bhostlabel=$baseFH->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
my $dhostlabel=$dhostlabels[0];print "LINE=".__LINE__."\n";
my $base_fdr=$args{BaseFileOrDir} || $args{BaseDir} || $args{BaseFile};print "LINE=".__LINE__."\n";
my $verbose=(exists $args{Verbose} && $args{Verbose}) ? 1 : 0;print "LINE=".__LINE__."\n";
my $skip_empty_dirs=
(exists $args{SkipEmptyDirs} && $args{SkipEmptyDirs}) ? 1 : 0;print "LINE=".__LINE__."\n";
my $index_base_once=
(exists $args{IndexBaseOnce} && $args{IndexBaseOnce}) ? 1 : 0;print "LINE=".__LINE__."\n";
$base_fdr||='';print "LINE=".__LINE__."\n";
$base_fdr=~s/[\/|\\]*$//;print "LINE=".__LINE__."\n";
if (unpack('a1',$base_fdr) eq '~') {
($stdout,$stderr)=$baseFH->cmd('echo ~');print "LINE=".__LINE__."\n";
$base_fdr=~s/~/$stdout/s;print "LINE=".__LINE__."\n";
}
my $dest_fdr=$args{DestDir};print "LINE=".__LINE__."\n";
$dest_fdr||='';print "LINE=".__LINE__."\n";
$dest_fdr=~s/[\/|\\]*$//;print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$btimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$btimeout) {
$btimeout=$timeout if !$btimeout;print "LINE=".__LINE__."\n";
}
my $bhost=($buse eq 'ip')?$bip:$bhostname;print "LINE=".__LINE__."\n";
$bms_share||='';$btransfer_dir||='';print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$dtimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$dtimeout) {
$dtimeout=$timeout if !$dtimeout;print "LINE=".__LINE__."\n";
} my $do_dest_tmp_cwd=1;print "LINE=".__LINE__."\n";
if ($baseFH->{_uname} ne 'cygwin' &&
$baseFH->{_hostlabel}->[0] ne "__Master_${$}__") {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,'lcd .',$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
unless ($output) {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,'!pwd',$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
} else {
$local_transfer_dir=unpack('x20 a*',$output);print "LINE=".__LINE__."\n";
}
$local_transfer_dir.='/';print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cwd($base_fdr) if $base_fdr;print "LINE=".__LINE__."\n";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{cd}=$base_fdr;print "LINE=".__LINE__."\n";
}
if ((exists $baseFH->{_smb})
|| $baseFH->{_uname} eq 'cygwin') {
my $test_chr1='';my $test_chr2='';print "LINE=".__LINE__."\n";
if ($base_fdr) {
$test_chr1=unpack('a1',$base_fdr);print "LINE=".__LINE__."\n";
if (1<length $base_fdr) {
$test_chr2=unpack('a2',$base_fdr);print "LINE=".__LINE__."\n";
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
$dir=$base_fdr;print "LINE=".__LINE__."\n";
if ($base_fdr=~/$baseFH->{_cygdrive_regex}/) {
$dir=~s/$baseFH->{_cygdrive_regex}//;print "LINE=".__LINE__."\n";
$dir=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
$dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cwd($base_fdr);print "LINE=".__LINE__."\n";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');print "LINE=".__LINE__."\n";
}
} else { $stderr='' }
$baseFH->{_ftp_handle}||='';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;print "LINE=".__LINE__."\n";
$do_dest_tmp_cwd=0;print "LINE=".__LINE__."\n";
} elsif ($bms_share) {
$dir="\\\\$bhost\\$bms_share";print "LINE=".__LINE__."\n";
$base_fdr=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dir.=$base_fdr;print "LINE=".__LINE__."\n";
} else {
if (exists $Net::FullAuto::FA_Core::cygpathw{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathw{$dir};print "LINE=".__LINE__."\n";
} else {
($dir,$stderr)=$baseFH->cmd("cygpath -w \"$dir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$dir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$dir}=$dir;print "LINE=".__LINE__."\n";
}
($output,$stderr)=$baseFH->cwd($base_fdr);print "LINE=".__LINE__."\n";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');print "LINE=".__LINE__."\n";
}
} 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;print "LINE=".__LINE__."\n";
}
$do_dest_tmp_cwd=0;print "LINE=".__LINE__."\n";
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\') {
$dir=$base_fdr;print "LINE=".__LINE__."\n";
} elsif ($test_chr2=~/^[a-zA-Z]:$/) {
$dir=$base_fdr;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cwd($base_fdr);print "LINE=".__LINE__."\n";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');print "LINE=".__LINE__."\n";
}
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;print "LINE=".__LINE__."\n";
$do_dest_tmp_cwd=0;print "LINE=".__LINE__."\n";
} elsif ($test_chr1!~/\W/) {
$dir=$baseFH->{_work_dirs}->{_cwd}.$base_fdr;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cwd($dir);print "LINE=".__LINE__."\n";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{cd}=$dir;print "LINE=".__LINE__."\n";
$do_dest_tmp_cwd=0;print "LINE=".__LINE__."\n";
} elsif ($test_chr1 ne '~') {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory (1) - $base_fdr CANNOT Be Located");print "LINE=".__LINE__."\n";
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
if ($baseFH->{_work_dirs}->{_cwd}=~
/$baseFH->{_cygdrive_regex}/) {
($dir=$baseFH->{_work_dirs}->{_cwd})=~
s/$baseFH->{_cygdrive_regex}//;print "LINE=".__LINE__."\n";
$dir=s/^(.)/$1:/;print "LINE=".__LINE__."\n";
$dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
} else {
$dir=$baseFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
$dir=$test_chr1.':/';print "LINE=".__LINE__."\n";
} elsif ($test_chr1 eq '.') {
$dir=$baseFH->{_cwd};print "LINE=".__LINE__."\n";
} elsif ($test_chr1 ne '~') {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory (2) - $base_fdr CANNOT Be Located");print "LINE=".__LINE__."\n";
} my $cnt=0;print "LINE=".__LINE__."\n";
} else {
$dir=$baseFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
} my $cnt=0;print "LINE=".__LINE__."\n";
if (!exists $main::base_shortcut_info{$baseFH} ||
$main::base_shortcut_info{$baseFH} ne $dir ||
!$index_base_once) {
while (1) {
($base_output,$stderr)=$baseFH->cmd(
"cmd /c dir /s /-C /A- \"$dir\"",'__delay__');print "LINE=".__LINE__."\n";
if ($stderr) {
my $die=$stderr;print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
$main::base_shortcut_info{$baseFH}=$dir if $index_base_once;print "LINE=".__LINE__."\n";
if (exists $baseFH->{_unaltered_basehash} &&
$baseFH->{_unaltered_basehash}) {
foreach my $key (keys %{$baseFH->{_bhash}}) {
if (ref ${$baseFH->{_bhash}}{$key} ne 'ARRAY') {
delete ${$baseFH->{_bhash}}{$key};print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
my $elems=$#{${$baseFH->{_bhash}}{$key}}+1;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$baseFH->{_bhash}}{$key}[$elems] ne 'HASH') {
undef ${$baseFH->{_bhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$baseFH->{_bhash}}{$key}[$elems]}) {
if (${${$baseFH->{_bhash}}{$key}[$elems]}{$key}) {
undef
@{${${$baseFH->{_bhash}}{$key}[$elems]}{$key}};print "LINE=".__LINE__."\n";
} delete ${${$baseFH->{_bhash}}{$key}[$elems]}{$key};print "LINE=".__LINE__."\n";
} undef %{${$baseFH->{_bhash}}{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$baseFH->{_bhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$baseFH->{_bhash}}{$key};print "LINE=".__LINE__."\n";
delete ${$baseFH->{_bhash}}{$key};print "LINE=".__LINE__."\n";
} undef %{$baseFH->{_bhash}};undef $baseFH->{_bhash};print "LINE=".__LINE__."\n";
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
if (ref $baseFH->{_unaltered_basehash}->{$key} ne 'ARRAY') {
delete $baseFH->{_unaltered_basehash}->{$key};print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
my $elems=$#{${$baseFH->{_unaltered_basehash}}{$key}}+1;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key}[$elems]
ne 'HASH') {
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}) {
if (${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}};print "LINE=".__LINE__."\n";
} delete ${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key};print "LINE=".__LINE__."\n";
} undef %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$baseFH->{_unaltered_basehash}}
{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$baseFH->{_unaltered_basehash}}{$key};print "LINE=".__LINE__."\n";
delete ${$baseFH->{_unaltered_basehash}}{$key};print "LINE=".__LINE__."\n";
} undef %{$baseFH->{_unaltered_basehash}};print "LINE=".__LINE__."\n";
$baseFH->{_unaltered_basehash}='';print "LINE=".__LINE__."\n";
}
if (!$stderr && $base_output!~/bytes free\s*/s) {
delete $main::base_shortcut_info{$baseFH} if
exists $main::base_shortcut_info{$baseFH};print "LINE=".__LINE__."\n";
$base_output='';next unless $cnt++;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
} else {
my %newelem=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];print "LINE=".__LINE__."\n";
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;print "LINE=".__LINE__."\n";
}
}
} else {
${$baseFH->{_bhash}}{$key}= # cygwin
${$baseFH->{_unaltered_basehash}}{$key};print "LINE=".__LINE__."\n";
}
}
} &Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
} elsif ($base_fdr) {
my $dir='';print "LINE=".__LINE__."\n";
if (unpack('a1',$base_fdr) ne '/' && $base_fdr!~/^\W/) {
$dir=$baseFH->{_work_dirs}->{_cwd}.$base_fdr;print "LINE=".__LINE__."\n";
} elsif (unpack('a1',$base_fdr) eq '/') {
$dir=$base_fdr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory (3) - $base_fdr CANNOT Be Located");print "LINE=".__LINE__."\n";
}
if (!exists $main::base_shortcut_info{$baseFH} ||
$main::base_shortcut_info{$baseFH} ne $dir ||
!$index_base_once) {
if (exists $args{BaseZip} && -f $dir.'/'.$args{BaseZip}) {
if (-e '/usr/bin/unzip') {
$base_unzip_path='/usr/bin/';print "LINE=".__LINE__."\n";
} elsif (-e '/bin/unzip') {
$base_unzip_path='/bin/';print "LINE=".__LINE__."\n";
} elsif (-e '/usr/local/bin/unzip') {
$base_unzip_path='/usr/local/bin/';print "LINE=".__LINE__."\n";
}
if (-e '/usr/bin/zip') {
$base_zip_path='/usr/bin/';print "LINE=".__LINE__."\n";
} elsif (-e '/bin/zip') {
$base_zip_path='/bin/';print "LINE=".__LINE__."\n";
} elsif (-e '/usr/local/bin/zip') {
$base_zip_path='/usr/local/bin/';print "LINE=".__LINE__."\n";
}
($base_output,$stderr)=$baseFH->cmd(
"${base_unzip_path}unzip -l $dir/$args{BaseZip}");print "LINE=".__LINE__."\n";
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;print "LINE=".__LINE__."\n";
if ($args{ZipBDir}) {
my $bo='';print "LINE=".__LINE__."\n";
foreach my $ln (split "\n", $base_output) {
next if -1<index $ln,'Archive:';print "LINE=".__LINE__."\n";
next unless -1<index $ln,$args{ZipBDir};print "LINE=".__LINE__."\n";
$bo.=$ln."\n";
} chop $bo;print "LINE=".__LINE__."\n";
$base_output=$bo;print "LINE=".__LINE__."\n";
}
} else {
my $ls_path='';print "LINE=".__LINE__."\n";
if ($baseFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};print "LINE=".__LINE__."\n";
$ls_path.='/' if $ls_path!~/\/$/;print "LINE=".__LINE__."\n";
}
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls --version");print "LINE=".__LINE__."\n";
if (-1<index $base_output,'GNU') {
$lsgnu=1;print "LINE=".__LINE__."\n";
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs --block-size=1 \'$dir\'");print "LINE=".__LINE__."\n";
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;print "LINE=".__LINE__."\n";
} else {
($base_output,$stderr)=
$baseFH->cmd("${ls_path}ls -lRFs \'$dir\'");print "LINE=".__LINE__."\n";
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;print "LINE=".__LINE__."\n";
}
if ($stderr) {
my $die=$stderr;print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} 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);print "LINE=".__LINE__."\n";
$dir=~s/\/?$//;print "LINE=".__LINE__."\n";
$base_fdr=$dir;print "LINE=".__LINE__."\n";
if ($lsgnu) {
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs --block-size=1 \'$dir\'");print "LINE=".__LINE__."\n";
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__
."\n" if $stderr;print "LINE=".__LINE__."\n";
} else {
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs \'$dir\'");print "LINE=".__LINE__."\n";
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__
."\n" if $stderr;print "LINE=".__LINE__."\n";
}
if ($stderr) {
my $die=$stderr;print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
}
$main::base_shortcut_info{$baseFH}=$dir if $index_base_once;print "LINE=".__LINE__."\n";
if ($baseFH->{_unaltered_basehash}) {
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
my $elems=$#{${$baseFH->{_unaltered_basehash}}{$key}}+1;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key}[$elems]
ne 'HASH') {
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}) {
if (${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}};print "LINE=".__LINE__."\n";
} delete ${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key};print "LINE=".__LINE__."\n";
} undef %{${$baseFH->{_unaltered_basehash}}{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$baseFH->{_unaltered_basehash}}{$key};
delete ${$baseFH->{_unaltered_basehash}}{$key};print "LINE=".__LINE__."\n";
} undef %{$baseFH->{_unaltered_basehash}};print "LINE=".__LINE__."\n";
$baseFH->{_unaltered_basehash}='';print "LINE=".__LINE__."\n";
}
}
} elsif (!exists $main::base_shortcut_info{$baseFH} ||
$main::base_shortcut_info{$baseFH} ne $dir ||
!$index_base_once) {
my $dir=$baseFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
$main::base_shortcut_info{$baseFH}=$dir if $index_base_once;print "LINE=".__LINE__."\n";
my $ls_path='';print "LINE=".__LINE__."\n";
if ($baseFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};print "LINE=".__LINE__."\n";
$ls_path.='/' if $ls_path!~/\/$/;print "LINE=".__LINE__."\n";
}
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls --version");print "LINE=".__LINE__."\n";
if (-1<index $base_output,'GNU') {
$lsgnu=1;print "LINE=".__LINE__."\n";
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dir\'");print "LINE=".__LINE__."\n";
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;print "LINE=".__LINE__."\n";
} else {
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls -lRs \'$dir\'");print "LINE=".__LINE__."\n";
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;print "LINE=".__LINE__."\n";
}
if ($baseFH->{_unaltered_basehash}) { # line 7144
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
my $elems=$#{${$baseFH->{_unaltered_basehash}}{$key}}+1;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key}[$elems]
ne 'HASH') {
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}) {
if (${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}};print "LINE=".__LINE__."\n";
} delete ${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key};print "LINE=".__LINE__."\n";
} undef %{${$baseFH->{_unaltered_basehash}}{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$baseFH->{_unaltered_basehash}}{$key};print "LINE=".__LINE__."\n";
delete ${$baseFH->{_unaltered_basehash}}{$key};print "LINE=".__LINE__."\n";
} undef %{$baseFH->{_unaltered_basehash}};print "LINE=".__LINE__."\n";
$baseFH->{_unaltered_basehash}='';print "LINE=".__LINE__."\n";
}
} else {
$baseFH->{_bhash}={};print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else {
my %newelem=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];print "LINE=".__LINE__."\n";
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;print "LINE=".__LINE__."\n";
}
}
} else {
${$baseFH->{_bhash}}{$key}=
${$baseFH->{_unaltered_basehash}}{$key};print "LINE=".__LINE__."\n";
}
}
}
if ($stderr) {
if (unpack('a10',$stderr) eq 'The System') {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
my $mdh=0;print "LINE=".__LINE__."\n";
my $timehash={};print "LINE=".__LINE__."\n";
if (!$baseFH->{_bhash}) {
my $hostlabel='';print "LINE=".__LINE__."\n";
eval {
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=&build_base_dest_hashes(
$base_fdr,\$base_output,$args{Directives},
$bhost,$bms_share,$bms_domain,$baseFH->{_uname},
$baseFH,'BASE',$lsgnu,$args{ZipBDir},$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if ($stderr eq 'redo ls') {
while (1) {
my $err='';print "LINE=".__LINE__."\n";
my $ls_path='';print "LINE=".__LINE__."\n";
if ($_[7]->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};print "LINE=".__LINE__."\n";
$ls_path.='/' if $ls_path!~/\/$/;print "LINE=".__LINE__."\n";
}
if ($lsgnu) {
($base_output,$err)=$_[7]->cmd(
"${ls_path}ls -lRs --block-size=1 \'$_[0]\'");print "LINE=".__LINE__."\n";
} else {
($base_output,$err)=$_[7]->cmd(
"${ls_path}ls -lRs \'$_[0]\'");print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($err,'-3') if $err;print "LINE=".__LINE__."\n";
($ignore,$stderr)=&build_base_dest_hashes(
$base_fdr,\$base_output,$args{Directives},
$bhost,$bms_share,$bms_domain,
$baseFH->{_uname},$baseFH,'BASE',
$lsgnu,$args{ZipBDir},$cache);print "LINE=".__LINE__."\n";
next if $stderr eq 'redo ls';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} else {
$hostlabel=$bhostlabel;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','',"$@";print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return '','','',$die;print "LINE=".__LINE__."\n";
}
}
## CREATING UNALTERED BASE HIGH
$baseFH->{_unaltered_basehash}={};print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else {
my %newelem=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];print "LINE=".__LINE__."\n";
}
push @{${$baseFH->{_unaltered_basehash}}{$key}}, \%newelem;print "LINE=".__LINE__."\n";
}
}
} else {
${$baseFH->{_unaltered_basehash}}{$key}=${$baseFH->{_bhash}}{$key};print "LINE=".__LINE__."\n";
}
}
}
foreach my $dhostlabel (@dhostlabels) {
my $activity=0;print "LINE=".__LINE__."\n";
%Net::FullAuto::FA_Core::file_rename=();print "LINE=".__LINE__."\n";
%Net::FullAuto::FA_Core::rename_file=();print "LINE=".__LINE__."\n";
($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);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$dtimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$dtimeout) {
$dtimeout=$timeout if !$dtimeout;print "LINE=".__LINE__."\n";
}
##=======================================
## 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_${$}__";print "LINE=".__LINE__."\n";
$destFH=$Net::FullAuto::FA_Core::localhost;print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cwd($destFH->{_work_dirs}->{_tmp});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else {
if ($dsu_id) { $chk_id=$dsu_id }
elsif ($dlogin_id) { $chk_id=$dlogin_id }
else { $chk_id=$username }
if (exists $Net::FullAuto::FA_Core::Connections{
"${dhostlabel}__%-$chk_id"}) {
$destFH=$Net::FullAuto::FA_Core::Connections{
"${dhostlabel}__%-$chk_id"};print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
}
} else {
if (exists $args{DestTimeout}) {
$dtimeout=$args{DestTimeout};print "LINE=".__LINE__."\n";
}
($destFH,$stderr)=&Net::FullAuto::FA_Core::connect_host(
$dhostlabel,$dtimeout);print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
}
}
$dms_share||='';print "LINE=".__LINE__."\n";
$dtransfer_dir||='';print "LINE=".__LINE__."\n";
my $dest_dir='';print "LINE=".__LINE__."\n";
my $dhost=($duse eq 'ip')?$dip:$dhostname;print "LINE=".__LINE__."\n";
my $die="The System $dhost Returned"
."\n the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n ";print "LINE=".__LINE__."\n";
my $err='';print "LINE=".__LINE__."\n";
($dest_output,$dest_dir,$err)=get_dest_ls_output(
$destFH,$dest_fdr,$dms_share,$dhost,$die);print "LINE=".__LINE__."\n";
if ($err) {
if (wantarray) {
return '',$err;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($err,'-7'); }
}
($output,$stderr)=$destFH->cwd($dest_dir)
if $dest_fdr && (!exists $destFH->{_smb});print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$destFH->{_dhash}}{$key}[$elems] ne 'HASH') {
undef ${$destFH->{_dhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$destFH->{_dhash}}{$key}[$elems]}) {
if (${${$destFH->{_dhash}}{$key}[$elems]}{$key}) {
undef @{${${$destFH->{_dhash}}{$key}[$elems]}{$key}};print "LINE=".__LINE__."\n";
} delete ${${$destFH->{_dhash}}{$key}[$elems]}{$key};print "LINE=".__LINE__."\n";
} undef %{${$destFH->{_dhash}}{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$destFH->{_dhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$destFH->{_dhash}}{$key};print "LINE=".__LINE__."\n";
delete ${$destFH->{_dhash}}{$key};print "LINE=".__LINE__."\n";
} undef %{$destFH->{_dhash}};print "LINE=".__LINE__."\n";
}
my $hostlabel='';print "LINE=".__LINE__."\n";
eval {
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',
$lsgnu,$args{ZipDDir},$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if ($stderr eq 'redo ls' ||
$stderr=~/does not exist/s) {
while (1) {
my $dest_output='';my $err='';print "LINE=".__LINE__."\n";
my $ls_path='';print "LINE=".__LINE__."\n";
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};print "LINE=".__LINE__."\n";
$ls_path.='/' if $ls_path!~/\/$/;print "LINE=".__LINE__."\n";
}
if ($lsgnu) {
($dest_output,$err)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_fdr\'");print "LINE=".__LINE__."\n";
} else {
($dest_output,$err)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_fdr\'");print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($err,'-3') if $err;print "LINE=".__LINE__."\n";
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',
$lsgnu,$args{ZipDDir},$cache);print "LINE=".__LINE__."\n";
next if $stderr eq 'redo ls';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} else {
$hostlabel=$dhostlabel;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-3');print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','',"$@";print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return '','','',$die;print "LINE=".__LINE__."\n";
}
}
my $newborn_dest_first_hash_flag=0;print "LINE=".__LINE__."\n";
if (ref $dest_first_hash eq 'HASH') {
foreach my $key (keys %{$dest_first_hash}) {
if (ref ${$dest_first_hash}{$key} ne 'ARRAY') {
undef ${$dest_first_hash}{$key};print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
my $elems=$#{${$dest_first_hash}{$key}}+1;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$dest_first_hash}{$key}[$elems] ne 'HASH') {
undef ${$dest_first_hash}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$dest_first_hash}{$key}[$elems]}) {
if (exists ${$dest_first_hash}{$key}[$elems]->{$key} &&
ref ${$dest_first_hash}{$key}[$elems]->{$key} eq 'ARRAY') {
undef @{${$dest_first_hash}{$key}[$elems]->{$key}};print "LINE=".__LINE__."\n";
} delete ${$dest_first_hash}{$key}[$elems]->{$key};print "LINE=".__LINE__."\n";
} undef %{${$dest_first_hash}{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$dest_first_hash}{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$dest_first_hash}{$key};print "LINE=".__LINE__."\n";
delete ${$dest_first_hash}{$key};print "LINE=".__LINE__."\n";
} undef %{$dest_first_hash};print "LINE=".__LINE__."\n";
}
## BUILDING FIRST DEST HASH
$dest_first_hash={};$newborn_dest_first_hash_flag=1;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else {
my %newelem=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$elem}) {
if (${${$elem}{$key}}[0] ne 'EXCLUDE') {
$newelem{$key}=[@{${$elem}{$key}}];print "LINE=".__LINE__."\n";
}
}
push @{${$dest_first_hash}{$key}}, \%newelem;print "LINE=".__LINE__."\n";
}
}
} else {
${$dest_first_hash}{$key}=${$destFH->{_dhash}}{$key};print "LINE=".__LINE__."\n";
}
}
my $shortcut=1;print "LINE=".__LINE__."\n";
if (!$newborn_dest_first_hash_flag) {
my $fdh=0;print "LINE=".__LINE__."\n";
TK: foreach my $key (keys %{$destFH->{_dhash}}) {
$fdh=1;print "LINE=".__LINE__."\n";
#print "SEARCHINGKEY=$key and VALUE=${$dest_first_hash}{$key}<==\n";print "LINE=".__LINE__."\n";
if (exists ${$dest_first_hash}{$key}) {
my %firstscalelems=();print "LINE=".__LINE__."\n";
my %firsthashelems=();print "LINE=".__LINE__."\n";
#print "MAKING NEW FIRSTHASHELEMS and ALL=",@{${$dest_first_hash}{$key}},"\n";print "LINE=".__LINE__."\n";
foreach my $felem (@{${$dest_first_hash}{$key}}) {
#print "ARE ALL FELEMS HASHES=$felem<==\n";print "LINE=".__LINE__."\n";
if ($felem eq 'EXCLUDE') {
delete ${$dest_first_hash}{$key};print "LINE=".__LINE__."\n";
next TK;print "LINE=".__LINE__."\n";
}
if (ref $felem ne 'HASH') {
#delete ${$dest_first_hash}{$key};print "LINE=".__LINE__."\n";
$firstscalelems{$felem}='-';print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
#print "KEYSSSSBABYYYY=",keys %{${${$dest_first_hash}{$key}}[1]},"<==\n";print "LINE=".__LINE__."\n";
#<STDIN>;print "LINE=".__LINE__."\n";
foreach my $key (keys %{$felem}) {
#print "POPULATINGFIRST KEY=$key and VALUE=@{${$felem}{$key}}\n";print "LINE=".__LINE__."\n";
$firsthashelems{$key}=${$felem}{$key};print "LINE=".__LINE__."\n";
}
} my $elemnum=-1;print "LINE=".__LINE__."\n";
foreach my $elem (@{${$destFH->{_dhash}}{$key}}) {
if ($elem eq 'EXCLUDE') {
delete ${$dest_first_hash}{$key};print "LINE=".__LINE__."\n";
next TK;print "LINE=".__LINE__."\n";
}
if (ref $elem ne 'HASH') {
if (!exists $firstscalelems{$elem}) {
#print "DEST SUBVALUE=$elem DOES NOT EXIST IN FIRST\n";print "LINE=".__LINE__."\n";
#print "SETTING SHORTCUT TO ZERO 1\n";<STDIN>;print "LINE=".__LINE__."\n";
$shortcut=0;last;print "LINE=".__LINE__."\n";
}
} else {
#print "PARENTKEY=$key\n";print "LINE=".__LINE__."\n";
#print "ELEMSKEYSSSSSSSSSSSSSSSS=",keys %{$elem},"<==\n";print "LINE=".__LINE__."\n";
#print "FIRSTHASHSSSSSSSSSSSSSSSS=",keys %firsthashelems,"<==\n";print "LINE=".__LINE__."\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";print "LINE=".__LINE__."\n";
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($elm,$key)
if $Net::FullAuto::FA_Core::f_sub;print "LINE=".__LINE__."\n";
if ($return &&
(-1<index $returned_modif,'e')) {
delete
${${$destFH->{_dhash}}{$key}}[$elemnum];print "LINE=".__LINE__."\n";
next TK;print "LINE=".__LINE__."\n";
}
#print "SETTING SHORTCUT TO ZERO 2\n";print "LINE=".__LINE__."\n";
$shortcut=0;last;print "LINE=".__LINE__."\n";
} else {
my $arr1=join '',@{${$elem}{$elm}};print "LINE=".__LINE__."\n";
my $arr2=join '',@{$firsthashelems{$elm}};print "LINE=".__LINE__."\n";
if ($arr1 ne $arr2) {
my ($mn1,$dy1,$hr1,$mt1,$yr1,$sz1)=
split ' ',$arr1;print "LINE=".__LINE__."\n";
my ($mn2,$dy2,$hr2,$mt2,$yr2,$sz2)=
split ' ',$arr2;print "LINE=".__LINE__."\n";
if ($sz1==$sz2) {
my $testnum='';print "LINE=".__LINE__."\n";
if ($hr1<$hr2) {
$testnum=$hr2-$hr1;print "LINE=".__LINE__."\n";
} 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};print "LINE=".__LINE__."\n";
next TK;print "LINE=".__LINE__."\n";
}
}
#print "0_ELEM VALUE=",$arr1,"<== DOES NOT EXIST IN FIRST\n";print "LINE=".__LINE__."\n";
#print "OKAY WHAT THE HECK IS THE ELEM VALUE=",$arr1,"<==\n";print "LINE=".__LINE__."\n";
#print "OKAY WHAT THE HECK IS THE FVALUE=",$arr2,"<==\n";#<STDIN>;print "LINE=".__LINE__."\n";
#print "SETTING SHORTCUT TO ZERO 3\n";sleep 3;print "LINE=".__LINE__."\n";
$shortcut=0;last;print "LINE=".__LINE__."\n";
}
}
} last if !$shortcut;print "LINE=".__LINE__."\n";
} else {
#print "0_ELEM BUT NOT FIRST\n";print "LINE=".__LINE__."\n";
#print "SETTING SHORTCUT TO ZERO 4\n";<STDIN>;print "LINE=".__LINE__."\n";
$shortcut=0;last;print "LINE=".__LINE__."\n";
}
} elsif (keys %firsthashelems) {
#print "0_FIRSTHASHELEMS=",keys %firsthashelems,"\n";print "LINE=".__LINE__."\n";
#print "SETTING SHORTCUT TO ZERO 5\n";<STDIN>;print "LINE=".__LINE__."\n";
$shortcut=0;last;print "LINE=".__LINE__."\n";
}
}
} last if !$shortcut;print "LINE=".__LINE__."\n";
} else {
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key)
if $Net::FullAuto::FA_Core::d_sub;print "LINE=".__LINE__."\n";
if ($return &&
-1<index $returned_modif,'e') {
delete
${$destFH->{_dhash}}{$key};print "LINE=".__LINE__."\n";
next TK;print "LINE=".__LINE__."\n";
} else { $shortcut=0;print "LINE=".__LINE__."\n";
#print "0_DEST KEY=$key DOES NOT EXIST IN FIRST\n";print "LINE=".__LINE__."\n";
#print "SETTING SHORTCUT TO ZERO 6\n";sleep 6;print "LINE=".__LINE__."\n";
}
} last if !$shortcut;print "LINE=".__LINE__."\n";
} $dest_first_hash={} if !$fdh;print "LINE=".__LINE__."\n";
} else {
## BUILDING FIRST BASE HASH
$baseFH->{_first_hash}={};print "LINE=".__LINE__."\n";
foreach my $key (keys %{$baseFH->{_bhash}}) {
#print "DO WE HAVE A KEY=$key<==\n";<STDIN>;print "LINE=".__LINE__."\n";
if (ref ${$baseFH->{_bhash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_bhash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_first_hash}}{$key}}, $elem;print "LINE=".__LINE__."\n";
} else {
my %newelem=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];print "LINE=".__LINE__."\n";
}
push @{${$baseFH->{_first_hash}}{$key}}, \%newelem;print "LINE=".__LINE__."\n";
}
}
} else {
${$baseFH->{_first_hash}}{$key}=[ ${$baseFH->{_bhash}}{$key} ];print "LINE=".__LINE__."\n";
}
}
%Net::FullAuto::FA_Core::renamefile=
%Net::FullAuto::FA_Core::rename_file;print "LINE=".__LINE__."\n";
$shortcut=0;print "LINE=".__LINE__."\n";
}
#print "WHAT IS SHORTCUT AFTER LOOKING AT FIRSTDESTHASH=$shortcut\n";sleep 5;print "LINE=".__LINE__."\n";
if ($shortcut) {
foreach my $key (keys %{$baseFH->{_bhash}}) {
if (ref ${$baseFH->{_bhash}}{$key} ne 'ARRAY') {
delete ${$baseFH->{_bhash}}{$key};print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
my $elems=$#{${$baseFH->{_bhash}}{$key}}+1;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$baseFH->{_bhash}}{$key}[$elems] ne 'HASH') {
undef ${$baseFH->{_bhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$baseFH->{_bhash}}{$key}[$elems]}) {
if (${${$baseFH->{_bhash}}{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_bhash}}{$key}[$elems]}{$key}};print "LINE=".__LINE__."\n";
} delete ${${$baseFH->{_bhash}}{$key}[$elems]}{$key};print "LINE=".__LINE__."\n";
} undef %{${$baseFH->{_bhash}}{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$baseFH->{_bhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$baseFH->{_bhash}}{$key};print "LINE=".__LINE__."\n";
delete ${$baseFH->{_bhash}}{$key};print "LINE=".__LINE__."\n";
} undef %{$baseFH->{_bhash}};$baseFH->{_bhash}={};print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else {
my %newelem=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];print "LINE=".__LINE__."\n";
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;print "LINE=".__LINE__."\n";
}
}
} else {
${$baseFH->{_bhash}}{$key}=${$baseFH->{_first_hash}}{$key};print "LINE=".__LINE__."\n";
}
}
foreach my $key (keys %{$destFH->{_dhash}}) {
my $elems=$#{${$destFH->{_dhash}}{$key}}+1;print "LINE=".__LINE__."\n";
while (-1<--$elems) {
if (ref ${$destFH->{_dhash}}{$key}[$elems] ne 'HASH') {
undef ${$destFH->{_dhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
} else {
foreach my $key (
keys %{${$destFH->{_dhash}}{$key}[$elems]}) {
if (${${$destFH->{_dhash}}{$key}[$elems]}{$key}) {
undef @{${${$destFH->{_dhash}}{$key}[$elems]}{$key}};print "LINE=".__LINE__."\n";
} delete ${${$destFH->{_dhash}}{$key}[$elems]}{$key};print "LINE=".__LINE__."\n";
} undef %{${$destFH->{_dhash}}{$key}[$elems]};print "LINE=".__LINE__."\n";
undef ${$destFH->{_dhash}}{$key}[$elems];print "LINE=".__LINE__."\n";
}
} undef ${$destFH->{_dhash}}{$key};print "LINE=".__LINE__."\n";
delete ${$destFH->{_dhash}}{$key};print "LINE=".__LINE__."\n";
} undef %{$destFH->{_dhash}};$destFH->{_dhash}={};print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else {
my %newelem=();print "LINE=".__LINE__."\n";
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];print "LINE=".__LINE__."\n";
}
push @{${$destFH->{_dhash}}{$key}}, \%newelem;print "LINE=".__LINE__."\n";
}
}
} else {
${$destFH->{_dhash}}{$key}=${$dest_first_hash}{$key};print "LINE=".__LINE__."\n";
}
}
}
$dest_output='';$deploy_info='';print "LINE=".__LINE__."\n";
($baseFH,$destFH,$timehash,$deploy_info,$debug_info)
=&build_mirror_hashes($baseFH,$destFH,$bhostlabel,
$dhostlabel,$verbose,$cache);print "LINE=".__LINE__."\n";
$bhostlabel="localhost - $Net::FullAuto::FA_Core::local_hostname"
if -1<index $bhostlabel,'__Mas';print "LINE=".__LINE__."\n";
$dhostlabel="localhost - $Net::FullAuto::FA_Core::local_hostname"
if -1<index $dhostlabel,'__Mas';print "LINE=".__LINE__."\n";
my $dhostname=$destFH->{'_hostname'};print "LINE=".__LINE__."\n";
if ($dhostlabel!~/^localhost/) {
unless ($dhostname) {
$dhostname=$destFH->{'_ip'};
}
if ($dhostname) {
$dhostlabel.=" - $dhostname";print "LINE=".__LINE__."\n";
}
}
my $bhostname=$baseFH->{'_hostname'};print "LINE=".__LINE__."\n";
if ($bhostlabel!~/^localhost/) {
unless ($bhostname) {
$bhostname=$baseFH->{'_ip'};print "LINE=".__LINE__."\n";
}
if ($bhostname) {
$bhostlabel.=" - $bhostname";print "LINE=".__LINE__."\n";
}
}
$mirror_output.="\n### mirror() output for Base Host:"
." $bhostlabel\n and Destination Host:"
." $dhostlabel\n\n$deploy_info";print "LINE=".__LINE__."\n";
$mirror_debug.="\n### mirror() debug for Base Host:\n"
." $bhostlabel\n and Destination Host:"
." $dhostlabel\n\n$debug_info";print "LINE=".__LINE__."\n";
#print "WHAT IS THIS=",keys %{$baseFH},"\n";print "LINE=".__LINE__."\n";
#print "KEYSBASEHASH=",keys %{$baseFH->{_bhash}},"\n";print "LINE=".__LINE__."\n";
#print "KEYSDESTHASH=",keys %{$destFH->{_dhash}},"\n";print "LINE=".__LINE__."\n";
#print "KEYSTIMEHASH=",keys %{$timehash},"\n";print "LINE=".__LINE__."\n";
if (keys %{$baseFH->{_bhash}}) {
if ($baseFH->{_uname} ne 'cygwin' ||
$base_fdr!~/^[\/|\\][\/|\\]/ ||
!$bms_share || !$#{$baseFH->{_hostlabel}}) {
my $base__dir=$base_fdr;print "LINE=".__LINE__."\n";
if ($base__dir!~/[^\/]\/$/ && $base__dir ne '/') {
$base__dir.='/';print "LINE=".__LINE__."\n";
}
my $bcurdir=$baseFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
my $aix_tar_input_variable_flag=0;print "LINE=".__LINE__."\n";
my $aix_tar_input_variable1='';print "LINE=".__LINE__."\n";
my $aix_tar_input_variable2='';print "LINE=".__LINE__."\n";
my $gnu_tar_input_file_flag=0;print "LINE=".__LINE__."\n";
my $gnu_tar_input_file1='';print "LINE=".__LINE__."\n";
my $gnu_tar_input_file2='';print "LINE=".__LINE__."\n";
my $gnu_tar_input_list1='';print "LINE=".__LINE__."\n";
my $gnu_tar_input_list2='';print "LINE=".__LINE__."\n";
my $solaris_tar_input_variable_flag=0;print "LINE=".__LINE__."\n";
my $solaris_tar_input_variable1='';print "LINE=".__LINE__."\n";
my $solaris_tar_input_variable2='';print "LINE=".__LINE__."\n";
my @dirt=();my $tmp_dir='';print "LINE=".__LINE__."\n";
if ($baseFH->{_uname} eq 'cygwin' &&
$destFH->{_uname} eq 'cygwin' &&
$dest_fdr=~/^[\/|\\][\/|\\]*/ &&
$dms_share && $#{$destFH->{_hostlabel}}) {
my $de_f=$dest_fdr;print "LINE=".__LINE__."\n";
$de_f=~s/^[\/\\]+//;print "LINE=".__LINE__."\n";
$de_f=~tr/\//\\/;my $ps='/';print "LINE=".__LINE__."\n";
if (exists $destFH->{_smb}) {
$dir="\\\\$dhost\\$dms_share\\$de_f";print "LINE=".__LINE__."\n";
$ps='\\';print "LINE=".__LINE__."\n";
} else {
$dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;print "LINE=".__LINE__."\n";
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';print "LINE=".__LINE__."\n";
}
my @basekeys=sort keys %{$baseFH->{_bhash}};print "LINE=".__LINE__."\n";
while (my $key=shift @basekeys) {
my @files=();print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
}
} my $tar_cmd='';my $save_dir='';print "LINE=".__LINE__."\n";
my $filearg='';my $farg='';print "LINE=".__LINE__."\n";
my $tdir='';my $filecount=0;my $fil_='';print "LINE=".__LINE__."\n";
foreach my $file (@files) {
$filecount++;print "LINE=".__LINE__."\n";
$file=~s/%/\\%/g;print "LINE=".__LINE__."\n";
if ($key eq '/') {
$farg.="\'$base__dir$file\' ";print "LINE=".__LINE__."\n";
$tdir=$dir;print "LINE=".__LINE__."\n";
} else {
$farg.="\'$base__dir$key/$file\' ";print "LINE=".__LINE__."\n";
my $tkey=$key;print "LINE=".__LINE__."\n";
$tkey=~tr/\//\\/ if ($ps ne '/');print "LINE=".__LINE__."\n";
$tdir="$dir$ps$tkey"
}
$fil_=$file;print "LINE=".__LINE__."\n";
if (1500 < length "cp -fpv $farg\'$tdir\'") {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($destFH);print "LINE=".__LINE__."\n";
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir$ps$file\"");print "LINE=".__LINE__."\n";
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
} $filearg=$farg;print "LINE=".__LINE__."\n";
}
if ($filearg) {
if ($filecount==1) {
my $testd=&Net::FullAuto::FA_Core::test_dir(
$destFH->{_cmd_handle},$tdir);print "LINE=".__LINE__."\n";
if ($testd) {
if ($testd eq 'READ') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir\"");print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="Destination Directory $tdir\n"
.' is NOT Writable!';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
} else {
#print "BE SURE TO ADD NEW CODE TO CHANGE BACK TO ",
# "MORE RESTRICTIVE PERMISSIONS\n";print "LINE=".__LINE__."\n";
}
} else {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($destFH);print "LINE=".__LINE__."\n";
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir$ps$fil_\"");print "LINE=".__LINE__."\n";
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
}
} else {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cmd(
"cmd /c mkdir $m\"$tdir\"",'__live__');print "LINE=".__LINE__."\n";
#'__display__','__notrap__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
}
} else {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($destFH);print "LINE=".__LINE__."\n";
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir/$fil_\"");print "LINE=".__LINE__."\n";
} 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");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tranback=2;print "LINE=".__LINE__."\n";
} $activity=0;print "LINE=".__LINE__."\n";
my @basekeys=sort keys %{$baseFH->{_bhash}};print "LINE=".__LINE__."\n";
my $f_cnt=0;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd("tar --help");print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE12 and TAROOUT=$output\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($stderr) {
if (-1<index $stderr,'-LInputList') {
$aix_tar_input_variable_flag=1;print "LINE=".__LINE__."\n";
} elsif (-1<index $stderr,'BDeEFhilmnopPqTvw') {
$solaris_tar_input_variable_flag=1;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');print "LINE=".__LINE__."\n";
}
} elsif ($output) {
if (-1<index $output,'GNU' ||
-1<index $output,'-T, --files-from=NAME') {
$gnu_tar_input_file_flag=1;
}
}
#my $cppath='';print "LINE=".__LINE__."\n";
#my $diffpath='';print "LINE=".__LINE__."\n";
while (my $key=shift @basekeys) {
my @files=();print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
}
} my $tar_cmd='';my $save_dir='';my $zdir_flag=0;print "LINE=".__LINE__."\n";
foreach my $file (sort @files) {
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY2\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$activity=1;print "LINE=".__LINE__."\n";
my $base___dir='';print "LINE=".__LINE__."\n";
my $dir= ($key eq '/') ? '' : "$key/";print "LINE=".__LINE__."\n";
#print "WHAT IS DIR=$dir<== and KEY=$key\n";print "LINE=".__LINE__."\n";
if ($dir && $baseFH->{_uname} eq 'cygwin') {
if (exists $Net::FullAuto::FA_Core::cygpathu{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathu{$dir};print "LINE=".__LINE__."\n";
} else {
($dir,$stderr)=$baseFH->cmd(
"cygpath -u \"$dir\"");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::cygpathu{$dir}=$dir;print "LINE=".__LINE__."\n";
}
my $bcd='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::cygpathu{
$base_fdr}) {
$bcd=$Net::FullAuto::FA_Core::cygpathu{$base_fdr};print "LINE=".__LINE__."\n";
} else {
($bcd,$stderr)=$baseFH->cmd(
"cygpath -u \"$base_fdr\"");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::cygpathu{$base_fdr}=$bcd;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY2 and DIR=$dir and BCD=$bcd\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$dir=~s/^(\/usr)*$bcd\/*//;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY2AFTER and DIR=$dir and BASE__DIR=$base__dir<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
}
my $dirt='';print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE10\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::file_rename{
"$dir$file"}) {
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE9\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $cmd="cp -Rpv \"$base__dir$dir$file\" "
."\"$bcurdir"
.$Net::FullAuto::FA_Core::file_rename{
"$dir$file"}."\"";print "LINE=".__LINE__."\n";
$file=$Net::FullAuto::FA_Core::file_rename{
"$dir$file"};print "LINE=".__LINE__."\n";
$base___dir=$bcurdir;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
$dirt=substr($dir,0,(index $dir,'/'));print "LINE=".__LINE__."\n";
$dir='';print "LINE=".__LINE__."\n";
if ($gnu_tar_input_file_flag) {
($gnu_tar_input_file2,$tarlistmpdir)=
$baseFH->tmp(
'tarlist2.txt')
if !$gnu_tar_input_file2;print "LINE=".__LINE__."\n";
$gnu_tar_input_list2.="$file\n";print "LINE=".__LINE__."\n";
$tmp_dir=$bcurdir;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE11 and FILE=$file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
push @dirt, $file;print "LINE=".__LINE__."\n";
} elsif ($aix_tar_input_variable_flag) {
$aix_tar_input_variable2.="${bcurdir}$file\n";print "LINE=".__LINE__."\n";
push @dirt, $file;print "LINE=".__LINE__."\n";
$tmp_dir=$bcurdir;print "LINE=".__LINE__."\n";
} elsif ($solaris_tar_input_variable_flag) {
$solaris_tar_input_variable2.="${bcurdir}$file\n";print "LINE=".__LINE__."\n";
push @dirt, $file;print "LINE=".__LINE__."\n";
$tmp_dir=$bcurdir;print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
#my $env=$baseFH->cmd('env');print "LINE=".__LINE__."\n";
#print "WHAT IS ID=$env<== and $ENV{HOME}\n";<STDIN>;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"$base_unzip_path/unzip -o -d ".
"$baseFH->{_cwd}FA_Diff_Report_Zip ".
"$args{BaseDir}/$args{BaseZip} ".
"\"$args{ZipBDir}/$dir$file\"");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
if ($same_host_as_Master{$destFH->{_ip}}) {
#unless ($cppath) {
# if (-e '/usr/bin/cp') {
# $cppath='/usr/bin/';print "LINE=".__LINE__."\n";
# } elsif (-e '/bin/cp') {
# $cppath='/bin/';print "LINE=".__LINE__."\n";
# } elsif (-e '/usr/local/bin/cp') {
# $cppath='/usr/local/bin/';print "LINE=".__LINE__."\n";
# }
#}
#unless ($diffpath) {
# if (-e '/usr/bin/diff') {
# $diffpath='/usr/bin/';print "LINE=".__LINE__."\n";
# } elsif (-e '/bin/diff') {
# $diffpath='/bin/';print "LINE=".__LINE__."\n";
# } elsif (-e '/usr/local/bin/diff') {
# $diffpath='/usr/local/bin/';print "LINE=".__LINE__."\n";
# }
#}
($output,$stderr)=
$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->(
'cp',$baseFH)."cp -fp ".
"$args{DestDir}/$dir$file ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.dest");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
($output,$stderr)=
$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->(
'diff',$baseFH)."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");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
($output,$stderr)=
$baseFH->cmd("rm -rf ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.dest");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
($output,$stderr)=
$baseFH->cmd("rm -rf ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
}
}
} elsif ($args{DESTZIP}) {
} else {
}
} elsif ($gnu_tar_input_file_flag) {
($gnu_tar_input_file1,$tarlistmpdir)=
$baseFH->tmp(
'tarlist1.txt')
if !$gnu_tar_input_file1;print "LINE=".__LINE__."\n";
$gnu_tar_input_list1.="$dir$file\n";print "LINE=".__LINE__."\n";
} elsif ($aix_tar_input_variable1) {
$aix_tar_input_variable1.="$dir$file\n";print "LINE=".__LINE__."\n";
} elsif ($solaris_tar_input_variable1) {
$solaris_tar_input_variable1.="$dir$file\n";print "LINE=".__LINE__."\n";
} else {
my $tar_cmd='';print "LINE=".__LINE__."\n";
if (!$f_cnt) {
$f_cnt++;print "LINE=".__LINE__."\n";
$tar_cmd=
"tar cvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";print "LINE=".__LINE__."\n";
} else {
$tar_cmd=
"tar rvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";print "LINE=".__LINE__."\n";
}
$tar_cmd.="-C \"$base___dir\" \"$dir$file\"";print "LINE=".__LINE__."\n";
${${$baseFH->{_bhash}}{$key}[1]{$file}}[0]
=~s/\s*$//;print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug)
|| $verbose) {
print "mirror() TAR CMD =>$tar_cmd<==",
" and BASE DIR=$base_fdr AND ATTRIBUTES=",
${${$baseFH->{_bhash}}{$key}[1]{$file}}[0],
" AND DIRECTORY=$key AND FILE=$file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"mirror() TAR CMD =>$tar_cmd<==".
" and BASE DIR=$base_fdr AND ATTRIBUTES=".
${${$baseFH->{_bhash}}{$key}[1]{$file}}[0].
" AND DIRECTORY=$key AND FILE=$file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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 DIRECTORY=$key AND FILE=$file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->('tar',$baseFH).
$tar_cmd,500);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr &&
$stderr!~/\[A(?:\[C)+\[K1/;print "LINE=".__LINE__."\n";
if ($dirt) {
my $cmd="rm -rf \"$base___dir/$dirt\"";print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1
if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
}
}
} @files=();print "LINE=".__LINE__."\n";
if (!$activity && !$skip_empty_dirs && $key ne '/'
&& ${$baseFH->{_bhash}}{$key}[0] eq 'ALL') {
# this block handles empty directories
$activity=1;print "LINE=".__LINE__."\n";
#unless ($cppath) {
# if (-e '/usr/bin/cp') {
# $cppath='/usr/bin/';print "LINE=".__LINE__."\n";
# } elsif (-e '/bin/cp') {
# $cppath='/bin/';print "LINE=".__LINE__."\n";
# } elsif (-e '/usr/local/bin/cp') {
# $cppath='/usr/local/bin/';print "LINE=".__LINE__."\n";
# }
#}
if (0) {
#if ($^O eq 'cygwin') {
if (exists
$Net::FullAuto::FA_Core::cygpathw{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathw{$dir};print "LINE=".__LINE__."\n";
} else {
my $cdr='';print "LINE=".__LINE__."\n";
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$dir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$dir}=$cdr;print "LINE=".__LINE__."\n";
$dir=$cdr;print "LINE=".__LINE__."\n";
}
}
if ($^O eq 'cygwin' && (-1<index $dir,'\\')) {
my $cdr='';print "LINE=".__LINE__."\n";
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath \"$dir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$dir=$cdr;print "LINE=".__LINE__."\n";
}
($output,$stderr)=$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->('cp',$baseFH).
"cp -Rfp $dir/$key $bcurdir");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $tar_cmd='';print "LINE=".__LINE__."\n";
if (!$f_cnt) {
$f_cnt++;print "LINE=".__LINE__."\n";
$tar_cmd=
"tar cvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";print "LINE=".__LINE__."\n";
} else {
$tar_cmd=
"tar rvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";print "LINE=".__LINE__."\n";
}
$tar_cmd.="-C \"$bcurdir\" \"$key\"";print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->('tar',$baseFH).
$tar_cmd);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr &&
$stderr!~/\[A(?:\[C)+\[K1/;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"rm -rf ${bcurdir}$key");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
}
} 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");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tranback=1;$activity=0;print "LINE=".__LINE__."\n";
} else { $activity=0 }
}
if ($_diff) {
my $curdir=$baseFH->{_cwd};print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cwd(
"$baseFH->{_cwd}FA_Diff_Report_Zip");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
($output,$stderr)=$baseFH->cmd(
"$base_zip_path/zip -r ".
"fa_diff_report *");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
($output,$stderr)=$baseFH->cmd(
"mv fa_diff_report.zip ..");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
($output,$stderr)=$baseFH->cmd(
"rm -rf $curdir/FA_Diff_Report_Zip");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
($output,$stderr)=$baseFH->cmd(
"chown $username $curdir/fa_diff_report.zip");print "LINE=".__LINE__."\n";
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');print "LINE=".__LINE__."\n";
}
} else {
if ($activity) {
if ($gnu_tar_input_list1) {
chomp $gnu_tar_input_list1;print "LINE=".__LINE__."\n";
my @files=split /^/, $gnu_tar_input_list1;print "LINE=".__LINE__."\n";
my $filearg='';my $farg='';print "LINE=".__LINE__."\n";
foreach my $fil (@files) {
$fil=~s/%/\\%/g;print "LINE=".__LINE__."\n";
$farg.=$fil;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE20 =$farg<= and $filearg<=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (1601 < length
"echo \"$farg\" >> \$gnu_tar_input_file1") {
chomp $filearg;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file1");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
$farg=$fil;print "LINE=".__LINE__."\n";
} $filearg=$farg;print "LINE=".__LINE__."\n";
}
if ($filearg) {
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE21 =$filearg<=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
chomp $filearg;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file1");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
my $tar_cmd=
"tar cvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";print "LINE=".__LINE__."\n";
$tar_cmd.="-C \"$base__dir\" -T \"$gnu_tar_input_file1\"";print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd($tar_cmd,'__display__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
if ($gnu_tar_input_list2) {
chomp $gnu_tar_input_list2;print "LINE=".__LINE__."\n";
my @files=split /^/, $gnu_tar_input_list2;print "LINE=".__LINE__."\n";
my $filearg='';my $farg='';print "LINE=".__LINE__."\n";
foreach my $fil (@files) {
$fil=~s/%/\\%/g;print "LINE=".__LINE__."\n";
$farg.=$fil;print "LINE=".__LINE__."\n";
if (1601 < length
"echo \"$farg\" >> \$gnu_tar_input_file2") {
chomp $filearg;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file2");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
$farg=$fil;print "LINE=".__LINE__."\n";
} $filearg=$farg;print "LINE=".__LINE__."\n";
}
if ($filearg) {
chomp $filearg;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file2");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
my $tar_cmd=
"tar rvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";print "LINE=".__LINE__."\n";
$tar_cmd.="-C \"$tmp_dir\" -T \"$gnu_tar_input_file2\"";print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd($tar_cmd);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
foreach my $dirt (@dirt) {
my $cmd="rm -rf \"$tmp_dir/$dirt\"";print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;print "LINE=".__LINE__."\n";
}
} 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,'*';print "LINE=".__LINE__."\n";
if (!$shortcut) {
($output,$stderr)=$baseFH->cmd(
"chmod -v 777 ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;print "LINE=".__LINE__."\n";
}
&move_tarfile($baseFH,$btransfer_dir,$destFH,
$shortcut,$cache,$tarlistmpdir);print "LINE=".__LINE__."\n";
#print "BASEFH=$baseFH\n";print "LINE=".__LINE__."\n";
#print "DESTFH=$destFH\n";print "LINE=".__LINE__."\n";
#print "BMS_SHARE=$bms_share\n";print "LINE=".__LINE__."\n";
#print "DMS_SHARE=$dms_share\n";print "LINE=".__LINE__."\n";
#print "LOCALTRANSFERDIR=$local_transfer_dir\n";print "LINE=".__LINE__."\n";
#print "TRANTAR=$trantar\n";print "LINE=".__LINE__."\n";
#print "BHOSTLABEL=$bhostlabel\n";print "LINE=".__LINE__."\n";
#print "DHOSTLABEL=$dhostlabel\n";print "LINE=".__LINE__."\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);print "LINE=".__LINE__."\n";
}
($dest_output,$dest_dir,$err)=get_dest_ls_output(
$destFH,$dest_fdr,$dms_share,$dhost,$die);print "LINE=".__LINE__."\n";
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',
$lsgnu,$args{ZipDDir},$cache);print "LINE=".__LINE__."\n";
($baseFH,$destFH,$timehash,$deploy_info,$debug_info)
=&build_mirror_hashes($baseFH,$destFH,
$bhostlabel,$dhostlabel,$verbose,$cache);print "LINE=".__LINE__."\n";
my @basekeys=sort keys %{$baseFH->{_bhash}};print "LINE=".__LINE__."\n";
while (my $key=shift @basekeys) {
my @files=();print "LINE=".__LINE__."\n";
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];print "LINE=".__LINE__."\n";
if ((split ' ',$ts)[4]==0) {
$ts=~s/^(\d+ \d+ \d+ \d+ )0( \d+)$/$1$curyear$2/;print "LINE=".__LINE__."\n";
}
$ts=unpack('x12 a4',$ts).unpack('a2',$ts).
unpack('x3 a2',$ts).unpack('x6 a2',$ts).
unpack('x9 a2',$ts);print "LINE=".__LINE__."\n";
my $key_dir=($key ne '/') ? "/$key/" : '/';print "LINE=".__LINE__."\n";
($stdout,$stderr)=$destFH->cmd(
"touch -t $ts \"$dest_fdr$key_dir$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
}
}
}
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);print "LINE=".__LINE__."\n";
next if $return && -1<index $returned_modif,'e';print "LINE=".__LINE__."\n";
} $excluded=0;print "LINE=".__LINE__."\n";
if (exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;print "LINE=".__LINE__."\n";
next if $return && -1<index $returned_modif,'e';print "LINE=".__LINE__."\n";
if ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) && (!exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
${$baseFH->{_unaltered_basehash}}{$key}[1]{$file}||='';print "LINE=".__LINE__."\n";
#print "SHORTCUT=$shortcut and THISSS=",
# ${$baseFH->{_unaltered_basehash}}{$key}[1]{$file},"<== and KEY=$key and FILE=$file\n";#<STDIN>;print "LINE=".__LINE__."\n";
if ($key eq '/') {
$activity=1;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (a) File ==> $file\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED (a) File ==> $file\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.="DELETED File ==> $file\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED File ==> $file\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (a) File ==> $file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (a) File ==> $file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (a) File ==> $file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil=$file;print "LINE=".__LINE__."\n";
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
} else {
$activity=1;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (b) File ==> $key/$file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED (b) File ==> $key/$file\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.=
"DELETED File ==> $key/$file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (b) File ==> $file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (b) File ==> $file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (b) File ==> $file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil="$key/$file";print "LINE=".__LINE__."\n";
$fil=~s/\//\\/g;print "LINE=".__LINE__."\n";
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$activity=1;print "LINE=".__LINE__."\n";
$key="$dest_fdr/." if $key eq '/';print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (c) Directory ==> $key\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED (c) Directory ==> $key\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.="DELETED Directory ==> $key\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED Directory ==> $key\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (c) Directory ==> $key\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (c) Directory ==> $key\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (c) Directory ==> $key\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $dir=$key;print "LINE=".__LINE__."\n";
$dir=~s/\//\\/g;print "LINE=".__LINE__."\n";
$dir=$destFH->{_work_dirs}->{_cwd_mswin}
.$dir;print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$dir\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
} else {
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$key\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
}
}
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;print "LINE=".__LINE__."\n";
$tdir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$tdir="\\\\$dhost\\$dms_share\\$tdir";print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cmd("cmd /c mkdir $tdir",
'__live__');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=$destFH->cmd("mkdir -p $key");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cmd("chmod -Rv $mode $key");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
$activity=1;print "LINE=".__LINE__."\n";
}
}
}
print $Net::FullAuto::FA_Core::MRLOG "WHAT THE HECK1 IS ACTIVITY=$activity\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $nodif="\n THERE ARE NO DIFFERENCES "
."BETWEEN THE BASE AND TARGET\n\n";print "LINE=".__LINE__."\n";
if ((!$activity) && ((!$Net::FullAuto::FA_Core::cron && $verbose)
|| $Net::FullAuto::FA_Core::debug)) {
print $nodif;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,$nodif])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG $nodif
if (!$activity) &&
$Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$mirror_output.=$nodif if !$activity;print "LINE=".__LINE__."\n";
$mirror_debug.=$nodif if !$activity;print "LINE=".__LINE__."\n";
push @main::test_tar_output, $mirror_output;print "LINE=".__LINE__."\n";
} else {
$activity=0;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$activity=1;print "LINE=".__LINE__."\n";
$trantar=move_files($baseFH,'/','',
$dest_fdr,
$destFH,$bms_share,
$dms_share,'DEPLOY_ALL',
$local_transfer_dir,'',
$bhostlabel,$dhostlabel,
'',$shortcut);print "LINE=".__LINE__."\n";
#'',$shortcut,\%desthash);print "LINE=".__LINE__."\n";
#if (exists $baseFH->{_smb}) {
#}
} else {
#print "HERE WE ARE FFFFTOP and $#{[keys %{$baseFH->{_bhash}}]}\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
my @basekeys=sort keys %{$baseFH->{_bhash}};my @files=();print "LINE=".__LINE__."\n";
while (my $key=shift @basekeys) {
#print "BASEKEYYYYYY=$key and ==>",${$baseFH->{_bhash}}{$key}[0],"<==\n";print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
#print "KEY=$key\n";print "LINE=".__LINE__."\n";
#print "DEST_FDR=$dest_fdr\n";print "LINE=".__LINE__."\n";
#print "DESTFH=$destFH\n";print "LINE=".__LINE__."\n";
#print "BMS_SHARE=$bms_share\n";print "LINE=".__LINE__."\n";
#print "DMS_SHARE=$dms_share\n";print "LINE=".__LINE__."\n";
#print "LOCAL=$local_transfer_dir\n";print "LINE=".__LINE__."\n";
#print "TRANTAR=$trantar\n";print "LINE=".__LINE__."\n";
#print "BHOSTLABEL=$bhostlabel\n";print "LINE=".__LINE__."\n";
#print "KEYYYYY=$key and DIREC=",${$baseFH->{_bhash}}{$key}[0],"\n";<STDIN>;print "LINE=".__LINE__."\n";
my $parentkey='';print "LINE=".__LINE__."\n";
if ($key ne '/') {
if (-1<index $key,'/') {
$parentkey=$key;print "LINE=".__LINE__."\n";
substr($parentkey,(rindex $parentkey,'/'))='';print "LINE=".__LINE__."\n";
next if exists ${$baseFH->{_bhash}}{$parentkey}[0]
&& ${$baseFH->{_bhash}}{$parentkey}[0] eq 'ALL';print "LINE=".__LINE__."\n";
$parentkey="\\$parentkey";print "LINE=".__LINE__."\n";
}
}
$trantar=move_files($baseFH,$key,'',
$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
$parentkey,$shortcut);print "LINE=".__LINE__."\n";
if ($basekeys[0] && (-1<index $basekeys[0],'/')) {
my $lkey=0;my $lbky=0;print "LINE=".__LINE__."\n";
$lkey=length $key;print "LINE=".__LINE__."\n";
$lbky=length $basekeys[0];print "LINE=".__LINE__."\n";
while ($lkey<=$lbky &&
unpack("a$lkey",$basekeys[0])
eq $key &&
(-1<index $basekeys[0],'/')) {
shift @basekeys;print "LINE=".__LINE__."\n";
}
} $activity=1;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY8" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
}
}
$trantar=move_files($baseFH,$key,
\@files,$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
'',$shortcut);print "LINE=".__LINE__."\n";
$activity=1;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY9" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY10" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$activity=1;print "LINE=".__LINE__."\n";
}
}
}
if ($activity && $trantar) { #&& (exists $baseFH->{_smb})
#&& !$dms_share) {
#print "WE HAVE ACIVITY AND TRANTAR=$trantar<==\n";print "LINE=".__LINE__."\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}\"";print "LINE=".__LINE__."\n";
my ($output,$stderr)=$baseFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;print "LINE=".__LINE__."\n";
}
my $cmd="cmd /c tar -C "
."\'transfer$Net::FullAuto::FA_Core::tran[3]\' -cvf "
."\'transfer$Net::FullAuto::FA_Core::tran[3].tar\' .";print "LINE=".__LINE__."\n";
$cmd=~tr/\\/\//;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd('pwd');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "TARRRPWDDDDD=$output\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my ($output,$stderr)=$baseFH->cmd($cmd);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"cmd /c rmdir /s /q transfer".
"$Net::FullAuto::FA_Core::tran[3]");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
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 -Rv 777 transfer".
"$Net::FullAuto::FA_Core::tran[3]");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=$baseFH->cmd(
"cmd /c rmdir /s /q transfer".
"$Net::FullAuto::FA_Core::tran[3]");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
}
#print "DO MOVETARFILE\n";print "LINE=".__LINE__."\n";
&move_tarfile($baseFH,$btransfer_dir,$destFH,
$shortcut,$cache,$tarlistmpdir);print "LINE=".__LINE__."\n";
if (keys %{$timehash}) {
#my $logreset=1;print "LINE=".__LINE__."\n";
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
($output,$stderr)=$destFH->cmd("touch --version");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr &&
(-1==index $stderr,'Not a recog') &&
(-1==index $stderr,'illegal opt');print "LINE=".__LINE__."\n";
#print "TOUCHOUT=$output and STDERR=$stderr\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
my $touch='';print "LINE=".__LINE__."\n";
$touch='GNU' if -1<index $output,'GNU';print "LINE=".__LINE__."\n";
foreach my $file (keys %{$timehash}) {
my $time='';print "LINE=".__LINE__."\n";
$time=${${$timehash}{$file}}[1];print "LINE=".__LINE__."\n";
$time=~tr/ //d;print "LINE=".__LINE__."\n";
if ($touch eq 'GNU') {
$time="$time${${$timehash}{$file}}[0]";print "LINE=".__LINE__."\n";
} else {
$time="${${$timehash}{$file}}[0]$time";print "LINE=".__LINE__."\n";
}
#print "GOING TO TOUCH TIME=$time and FILE=$file\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd('touch -t'." $time \"$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
#$Net::FullAuto::FA_Core::log=0 if $logreset;print "LINE=".__LINE__."\n";
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);print "LINE=".__LINE__."\n";
next if $return && -1<index $returned_modif,'e';print "LINE=".__LINE__."\n";
} $excluded=0;print "LINE=".__LINE__."\n";
if (!$shortcut && exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (
keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;print "LINE=".__LINE__."\n";
next if $return && -1<index $returned_modif,'e';print "LINE=".__LINE__."\n";
if ((exists $args{DeleteOnDest}
&& $args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (d) File ==> $file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED (d) File ==> $file\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.=
"DELETED File ==> $file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED File ==> $file\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (d) File ==> $file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (d) File ==> $file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (d) File ==> $file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil=$file;print "LINE=".__LINE__."\n";
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (e) File ==> $key/$file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED (e) File ==> $key/$file\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.=
"DELETED File ==> $key/$file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (e) File ==> $file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (e) File ==> $file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (e) File ==> $file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil="$key/$file";print "LINE=".__LINE__."\n";
$fil=~s/\//\\/g;print "LINE=".__LINE__."\n";
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$key="$dest_fdr/." if $key eq '/';print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (f) Directory ==> $key\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED (f) Directory ==> $key\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.="DELETED Directory ==> $key\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED Directory ==> $key\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (f) Directory ==> $key\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (f) Directory ==> $key\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (f) Directory ==> $key\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $dir=$key;print "LINE=".__LINE__."\n";
$dir=~s/\//\\/g;print "LINE=".__LINE__."\n";
$dir=$destFH->{_work_dirs}->{_cwd_mswin}
.$dir;print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$dir\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
} else {
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$key\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
}
}
}
} elsif (!$activity) {
my $nodif='';my $excluded=0;print "LINE=".__LINE__."\n";
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);print "LINE=".__LINE__."\n";
next if $return && -1<index $returned_modif,'e';print "LINE=".__LINE__."\n";
} $excluded=0;print "LINE=".__LINE__."\n";
if (exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;print "LINE=".__LINE__."\n";
next if $return && -1<index $returned_modif,'e';print "LINE=".__LINE__."\n";
if ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (g) File ==> $file\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED (g) File ==> $file\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.="DELETED File ==> $file\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED File ==> $file\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (g) File ==> $file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (g) File ==> $file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (g) File ==> $file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (h) File ==> $key/$file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED (h) File ==> $key/$file\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.=
"DELETED File ==> $key/$file\n";print "LINE=".__LINE__."\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (h) File ==> $key/$file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (h) File ==> $key/$file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (h) File ==> $key/$file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$key="$dest_fdr/." if $key eq '/';print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (i) Directory ==> $key\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED (i) Directory ==> $key\n";print "LINE=".__LINE__."\n";
} else {
$mirror_output.="DELETED Directory ==> $key\n";print "LINE=".__LINE__."\n";
$mirror_debug.="DELETED Directory ==> $key\n";print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (i) Directory ==> $key\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DELETING (i) Directory ==> $key\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"DELETING (i) Directory ==> $key\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my ($output,$stderr)=
$destFH->cmd("rm -rf $key");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
}
print $Net::FullAuto::FA_Core::MRLOG "WHAT THE HECK2 IS ACTIVITY=$activity\n"
if defined $Net::FullAuto::FA_Core::MRLOG;print "LINE=".__LINE__."\n";
$nodif="\n THERE ARE NO DIFFERENCES "
."BETWEEN THE BASE AND TARGET\n\n";print "LINE=".__LINE__."\n";
if ((!$activity) && ((!$Net::FullAuto::FA_Core::cron && $verbose)
|| $Net::FullAuto::FA_Core::debug)) {
print $nodif;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,$nodif])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG $nodif
if (!$activity) &&
$Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$mirror_output.=$nodif if !$activity;print "LINE=".__LINE__."\n";
$mirror_debug.=$nodif if !$activity;print "LINE=".__LINE__."\n";
push @main::test_tar_output, $mirror_output;print "LINE=".__LINE__."\n";
}
}
}
}
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});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
if (wantarray) {
return $mirror_output,$mirror_debug;print "LINE=".__LINE__."\n";
} else { return $mirror_output }
}
sub get_drive
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "get_drive() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my ($folder,$base_or_dest,$cmd_handle,$hostlabel)=('','','','');print "LINE=".__LINE__."\n";
($folder,$base_or_dest,$cmd_handle,$hostlabel)=@_;print "LINE=".__LINE__."\n";
$cmd_handle||='';print "LINE=".__LINE__."\n";
my ($output,$stderr)=('','');print "LINE=".__LINE__."\n";
my @drvs=();my $dir='';print "LINE=".__LINE__."\n";
if (unpack('a1',$folder) eq '/' ||
unpack('a1',$folder) eq '\\') {
$dir=unpack('a1',$folder);print "LINE=".__LINE__."\n";
} else { $dir=$folder }
$dir=~tr/\\/\//;print "LINE=".__LINE__."\n";
my $ms_dir=$dir;print "LINE=".__LINE__."\n";
$ms_dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$ms_dir=~s/\\/\\\\/g;my $drvs='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::drives{$hostlabel}) {
$drvs=$Net::FullAuto::FA_Core::drives{$hostlabel};print "LINE=".__LINE__."\n";
} else {
my $sav_curdir='';print "LINE=".__LINE__."\n";
if ($cmd_handle) {
bless $cmd_handle, 'File_Transfer';print "LINE=".__LINE__."\n";
($sav_curdir,$stderr)=$cmd_handle->cmd('pwd');print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::cygpathw{$sav_curdir}) {
$sav_curdir=$Net::FullAuto::FA_Core::cygpathw{$sav_curdir};print "LINE=".__LINE__."\n";
} else {
($sav_curdir,$stderr)=$cmd_handle->cmd(
"cygpath -w \"$sav_curdir\"");print "LINE=".__LINE__."\n";
&handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$sav_curdir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::cygpathw{$sav_curdir}=$sav_curdir;print "LINE=".__LINE__."\n";
}
($output,$stderr)=$cmd_handle->cwd($cmd_handle->{_cygdrive});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($drvs,$stderr)=$cmd_handle->cmd('ls');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} elsif ($^O eq 'cygwin') {
$sav_curdir=Cwd::getcwd();print "LINE=".__LINE__."\n";
chdir $Net::FullAuto::FA_Core::localhost->{_cygdrive};print "LINE=".__LINE__."\n";
$drvs=`ls`;print "LINE=".__LINE__."\n";
}
if ($cmd_handle) {
($output,$stderr)=$cmd_handle->cwd($sav_curdir);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else { chdir $sav_curdir }
$Net::FullAuto::FA_Core::drives{$hostlabel}=$drvs;print "LINE=".__LINE__."\n";
}
foreach my $drv (split /\n/, $drvs) {
last unless $drv;print "LINE=".__LINE__."\n";
if ($cmd_handle) {
my $result=&Net::FullAuto::FA_Core::test_dir(
$cmd_handle->{_cmd_handle},
$cmd_handle->{_cygdrive}."/$drv/$dir/");print "LINE=".__LINE__."\n";
if ($result ne 'NODIR') {
if ($ms_dir && $ms_dir ne '\\\\') {
push @drvs, "$drv:\\$ms_dir\\";print "LINE=".__LINE__."\n";
} else { push @drvs, "$drv:\\" }
}
} elsif (-d "$drv:\\$ms_dir") {
if ($ms_dir && $ms_dir ne '\\\\') {
push @drvs, "$drv:\\$ms_dir\\";print "LINE=".__LINE__."\n";
} else { push @drvs, "$drv:\\" }
}
}
if (-1<$#drvs) {
if ($#drvs==0) {
$dir=$drvs[0];print "LINE=".__LINE__."\n";
} else {
my $banner="\n Please Pick a $base_or_dest Directory\n"
." on the Local Host "
."$Net::FullAuto::FA_Core::Local_HostName :";print "LINE=".__LINE__."\n";
$dir=&Term::Menus::pick(\@drvs,$banner);print "LINE=".__LINE__."\n";
}
my ($drive,$path)=unpack('a1 x1 a*',$dir);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
if ($cmd_handle) {
$folder=$cmd_handle->{_cygdrive}.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
} else {
$folder=$Net::FullAuto::FA_Core::localhost->{_cygdrive}.'/'.
lc($drive).$path.'/';print "LINE=".__LINE__."\n";
}
} else {
my $die="Cannot Locate Directory $folder\n"
." Anywhere on Local $base_or_dest Host "
."$Net::FullAuto::FA_Core::Local_HostName\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
if (wantarray) {
return $folder,$dir
} else { return $folder }
}
sub get_dest_ls_output {
my $destFH=$_[0];print "LINE=".__LINE__."\n";
my $dest_fdr=$_[1]||'';print "LINE=".__LINE__."\n";
my $dms_share=$_[2]||'';print "LINE=".__LINE__."\n";
my $dhost=$_[3]||'';print "LINE=".__LINE__."\n";
my $die=$_[4]||'';print "LINE=".__LINE__."\n";
my $dest_dir='';print "LINE=".__LINE__."\n";
my $dest_output='';print "LINE=".__LINE__."\n";
my $stderr='';my $lsgnu=0;print "LINE=".__LINE__."\n";
if ($destFH->{_uname} eq 'cygwin') {
my ($test_chr1,$test_chr2)='';print "LINE=".__LINE__."\n";
if ($dest_fdr) {
$test_chr1=unpack('a1',$dest_fdr);print "LINE=".__LINE__."\n";
if (1<length $dest_fdr) {
$test_chr2=unpack('a2',$dest_fdr);print "LINE=".__LINE__."\n";
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
$dest_dir=$dest_fdr;print "LINE=".__LINE__."\n";
if ($dest_dir=~s/$destFH->{_cygdrive_regex}//) {
$dest_dir=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
$dest_dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
} else {
my $de_f=$dest_fdr;print "LINE=".__LINE__."\n";
$de_f=~s/^[\/\\]+//;print "LINE=".__LINE__."\n";
$de_f=~tr/\//\\/;print "LINE=".__LINE__."\n";
if (exists $destFH->{_smb}) {
$dest_dir="\\\\$dhost\\$dms_share\\$de_f";print "LINE=".__LINE__."\n";
} else {
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;print "LINE=".__LINE__."\n";
#print "JDKKDK\n";<STDIN>;print "LINE=".__LINE__."\n";
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';print "LINE=".__LINE__."\n";
}
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\') {
$dest_dir=$dest_fdr;print "LINE=".__LINE__."\n";
#print "NAKED\n";<STDIN>;print "LINE=".__LINE__."\n";
} elsif ($test_chr2=~/^[a-zA-Z]:$/) {
$dest_dir=$dest_fdr;print "LINE=".__LINE__."\n";
#print "NAKED\n";<STDIN>;print "LINE=".__LINE__."\n";
} elsif ($test_chr1!~/\W/) {
my $de_f=$dest_fdr;print "LINE=".__LINE__."\n";
$de_f=~s/^[\/\\]+//;print "LINE=".__LINE__."\n";
$de_f=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;print "LINE=".__LINE__."\n";
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';print "LINE=".__LINE__."\n";
} else {
my $die="Destination Directory (1) - $dest_fdr"
." CANNOT Be Located";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
$dest_dir=$dest_fdr;print "LINE=".__LINE__."\n";
if ($dest_dir=~s/$destFH->{_cygdrive_regex}//) {
$dest_dir=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
$dest_dir=~tr/\//\\/;print "LINE=".__LINE__."\n";
#print "OLSKDKF\n";print "LINE=".__LINE__."\n";
} else {
my $de_f=$dest_fdr;print "LINE=".__LINE__."\n";
$de_f=~s/^[\/\\]+//;print "LINE=".__LINE__."\n";
$de_f=~tr/\//\\/;print "LINE=".__LINE__."\n";
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;print "LINE=".__LINE__."\n";
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';print "LINE=".__LINE__."\n";
#print "WOOEEE\n";print "LINE=".__LINE__."\n";
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
#print "BLECKKK\n";print "LINE=".__LINE__."\n";
$dest_dir=$test_chr1 . ':\\';print "LINE=".__LINE__."\n";
} else {
my $die="Destination Directory (2) - $dest_fdr"
." CANNOT Be Located";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
} else {
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
} my $cnt=0;print "LINE=".__LINE__."\n";
while (1) {
($dest_output,$stderr)=$destFH->cmd(
"cmd /c dir /s /-C /A- \"$dest_dir\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr.
" when attempting command:\n\n".
" cmd /c dir /s /-C /A- \"$dest_dir\"",
'-1') if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
if ($dest_output!~/bytes free\s*/s) {
$dest_output='';next unless $cnt++;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-1');print "LINE=".__LINE__."\n";
} else { last }
}
} elsif ($dest_fdr) {
my $test_char=unpack('a1',$dest_fdr);print "LINE=".__LINE__."\n";
if ($test_char ne '/' && $test_char ne '.') {
$dest_dir=$destFH->{_work_dirs}->{_cwd}
.$dest_fdr;print "LINE=".__LINE__."\n";
} else {
$dest_dir=$dest_fdr;print "LINE=".__LINE__."\n";
}
my $ls_path='';print "LINE=".__LINE__."\n";
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};print "LINE=".__LINE__."\n";
$ls_path.='/' if $ls_path!~/\/$/;print "LINE=".__LINE__."\n";
}
($dest_output,$stderr)=$destFH->cmd("${ls_path}ls --version");print "LINE=".__LINE__."\n";
if (-1<index $dest_output,'GNU') {
$lsgnu=1;print "LINE=".__LINE__."\n";
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_dir\'");print "LINE=".__LINE__."\n";
} else {
$lsgnu=0;print "LINE=".__LINE__."\n";
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_dir\'");print "LINE=".__LINE__."\n";
}
if ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "$die$stderr"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return '', '', "$die$stderr";print "LINE=".__LINE__."\n";
}
} else {
my $dest_dir=$destFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
my $ls_path='';print "LINE=".__LINE__."\n";
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};print "LINE=".__LINE__."\n";
$ls_path.='/' if $ls_path!~/\/$/;print "LINE=".__LINE__."\n";
}
($dest_output,$stderr)=$destFH->cmd("${ls_path}ls --version");print "LINE=".__LINE__."\n";
if (-1<index $dest_output,'GNU') {
$lsgnu=1;print "LINE=".__LINE__."\n";
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_dir\'");print "LINE=".__LINE__."\n";
} else {
$lsgnu=0;print "LINE=".__LINE__."\n";
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_dir\'");print "LINE=".__LINE__."\n";
}
if ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "$die$stderr"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return '', '', "$die$stderr";print "LINE=".__LINE__."\n";
}
}
return $dest_output,$dest_dir,'';print "LINE=".__LINE__."\n";
}
sub move_tarfile
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "move_tarfile() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my ($baseFH,$btransfer_dir,$destFH,$shortcut,$cache,$tarlistmpdir)=
('','','','','','');print "LINE=".__LINE__."\n";
($baseFH,$btransfer_dir,$destFH,$shortcut,$cache,$tarlistmpdir)=@_;print "LINE=".__LINE__."\n";
my ($output,$stdout,$stderr)=('','','');print "LINE=".__LINE__."\n";
my $dest_fdr=$destFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
my $bprxFH='';my $dprxFH='';my $d_fdr='';print "LINE=".__LINE__."\n";
my $trandir_parent='';print "LINE=".__LINE__."\n";
my $phost= $baseFH->{_hostlabel}->[1]?
$baseFH->{_hostlabel}->[1]:
$baseFH->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
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}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$destFH->{_ftp_handle}||='';
$d_fdr=$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}=
$destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"lcd \"$dest_fdr\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$d_fdr=$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}=
$dest_fdr;print "LINE=".__LINE__."\n";
}
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}",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"cd $baseFH->{_work_dirs}->{_cwd}",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
} 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}\"",$cache);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{lcd}=
$baseFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
}
if ($destFH->{_work_dirs}->{_tmp}) { # If DEST has trandir
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd \"$destFH->{_work_dirs}->{_tmp}\"",$cache);print "LINE=".__LINE__."\n";
# cd ftp handle to trandir
$d_fdr=$destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
if (exists $destFH->{_smb}) { # If DEST needs SMB
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"mkdir \"transfer$Net::FullAuto::FA_Core::tran[3]\"",
$cache); # Add tmp 'transfer' dir
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr && (-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[4]=1;print "LINE=".__LINE__."\n";
($output,$stderr)=
&Rem_Command::ftpcmd($destFH, # cd ftp handle to 'transfer'
"cd \"transfer$Net::FullAuto::FA_Core::tran[3]\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}
="transfer$Net::FullAuto::FA_Core::tran[3]";print "LINE=".__LINE__."\n";
$d_fdr.="transfer$Net::FullAuto::FA_Core::tran[3]";print "LINE=".__LINE__."\n";
}
} else { # No trandir on DEST,
($output,$stderr)=&Rem_Command::ftpcmd( # use $dest_fdr for transfer
$destFH,"cd \"$dest_fdr\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}
=$d_fdr=$dest_fdr;print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd( # Transfer the tar file
$destFH,"!id",$cache); # 'put' because DEST is remote
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "move_tarfile() TRYING TO DO PUT (1)\n";
$cache->set($cache->{'key'},[0,
"move_tarfile() TRYING TO DO PUT (1)\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"move_tarfile() TRYING TO DO PUT (1)\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd( # Transfer the tar file
$destFH, # 'put' because DEST is remote
"put transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);print "LINE=".__LINE__."\n";
if (-1<index "$output","permissions do not") {
&Net::FullAuto::FA_Core::handle_error($output,'-1');print "LINE=".__LINE__."\n";
die "$output $!"
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
if ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(
$destFH, # lcd ftp handle back to parent
"lcd \"$baseFH->{_work_dirs}->{_tmp}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}
=$baseFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
} 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}
);print "LINE=".__LINE__."\n";
if ($destFH->{_uname} ne 'cygwin' ||
$dest_fdr!~/^[\/|\\][\/|\\]/ ||
!$destFH->{_ms_share} || !$#{$destFH->{_hostlabel}}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd \"$dest_fdr\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
#print "SAVING LCD PATH OF DEST2=transfer$Net::FullAuto::FA_Core::tran[3]\n";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{lcd}
=$d_fdr=$dest_fdr;print "LINE=".__LINE__."\n";
} else {
if ($destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd \"$destFH->{_work_dirs}->{_tmp}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$d_fdr=$destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"!mkdir ${m}transfer$Net::FullAuto::FA_Core::tran[3]",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[4]=1;print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd transfer$Net::FullAuto::FA_Core::tran[3]",$cache);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{lcd}
="transfer$Net::FullAuto::FA_Core::tran[3]";print "LINE=".__LINE__."\n";
$d_fdr.="transfer$Net::FullAuto::FA_Core::tran[3]";print "LINE=".__LINE__."\n";
}
if ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$baseFH->{_work_dirs}->{_tmp}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
my ($output,$stderr)=$baseFH->cwd(
$baseFH->{_work_dirs}->{_tmp});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
=$baseFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$baseFH->{_work_dirs}->{_cwd}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
="$baseFH->{_work_dirs}->{_cwd}";print "LINE=".__LINE__."\n";
}
#print "GOING TO GET THE TAR AND BRING IT TO DESTTTTTTTTTTTTTTTTT\n";print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
my $prompt = '_funkyPrompt_';print "LINE=".__LINE__."\n";
$destFH->{_cmd_handle}->prompt("/$prompt\$/");print "LINE=".__LINE__."\n";
$destFH->{_cmd_handle}->print('bye');print "LINE=".__LINE__."\n";
while (my $line=$destFH->{_cmd_handle}->get) {
#print "GETTING BACK THE CMD FROM FTP LINE=$line\n";print "LINE=".__LINE__."\n";
last if $line=~/_funkyPrompt_/s;print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='cmd';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;print "LINE=".__LINE__."\n";
last DH;print "LINE=".__LINE__."\n";
}
}
}
}
} 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($baseFH,
"cd \"$baseFH->{_work_dirs}->{_tmp}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
($stdout,$stderr)=$baseFH->cmd(
"cd \"$baseFH->{_work_dirs}->{_tmp}\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
=$baseFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd(
$baseFH,"get transfer$Net::FullAuto::FA_Core::tran[3].tar",
$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
if (exists $destFH->{_smb}) {
if ($destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd \"$destFH->{_work_dirs}->{_tmp}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$d_fdr=$destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"mkdir transfer$Net::FullAuto::FA_Core::tran[3]",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[4]=1;print "LINE=".__LINE__."\n";
$d_fdr.="transfer$Net::FullAuto::FA_Core::tran[3]";print "LINE=".__LINE__."\n";
} else {
$d_fdr=$destFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd $d_fdr",$cache);print "LINE=".__LINE__."\n";
if ($stderr && -1==index $stderr,'command success') {
my $die="The System $destFH->{_hostlabel}->[0]"
." Returned\n the Following "
."Unrecoverable Error "
."Condition :\n\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} $Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}=$d_fdr;print "LINE=".__LINE__."\n";
my $putoutput='';print "LINE=".__LINE__."\n";
($putoutput,$stderr)=&Rem_Command::ftpcmd($destFH,
"put transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);print "LINE=".__LINE__."\n";
#&ftp($destFH,'',
# "put transfer$Net::FullAuto::FA_Core::tran[3].tar");print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cwd('/tmp');print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"put transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr && (-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cmd(
"mv transfer$Net::FullAuto::FA_Core::tran[3].tar $d_fdr");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cwd($d_fdr);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr;print "LINE=".__LINE__."\n";
} elsif ($stderr && -1==index $stderr,'command success') {
my $die="The System $destFH->{_hostlabel}->[0]"
." Returned\n the Following "
."Unrecoverable Error "
."Condition :\n\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
} elsif ($Net::FullAuto::FA_Core::DeployFTM_Proxy[0]) {
#print "IM HERE THIS\n";print "LINE=".__LINE__."\n";
($bprxFH,$stderr)=
Rem_Command::new('Rem_Command',
$Net::FullAuto::FA_Core::DeployFTM_Proxy[0]);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
my $bprx={
_cmd_handle => $bprxFH,
};print "LINE=".__LINE__."\n";
&ftm_connect($bprx,$phost);print "LINE=".__LINE__."\n";
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='';print "LINE=".__LINE__."\n";
if ($btransfer_dir) {
if (unpack('@1 a1',"$btransfer_dir") eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$btransfer_dir);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
$btrandir=$baseFH->{_cygdrive}.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
} elsif (substr($btransfer_dir,-1) ne '/') {
$btrandir.='/';print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd(
\%bftp,"cd \"$btrandir\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$bprx->{_cmd_handle}}{cd}=$btrandir;print "LINE=".__LINE__."\n";
} elsif ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(
\%bftp,"cd $baseFH->{_work_dirs}->{_tmp}",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$bprx->{_cmd_handle}}{cd}=
$baseFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=&Rem_Command::ftpcmd(\%bftp,
"cd \"$baseFH->{_work_dirs}->{_cwd}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$bprx->{_cmd_handle}}{cd}=
$baseFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
}
($output,$stderr)=&Rem_Command::ftpcmd(\%bftp,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
my $prompt = '_funkyPrompt_';print "LINE=".__LINE__."\n";
$bprx->{_cmd_handle}->prompt("/$prompt\$/");print "LINE=".__LINE__."\n";
$bprx->{_cmd_handle}->cmd('bye');print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='cmd';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;print "LINE=".__LINE__."\n";
last BPH;print "LINE=".__LINE__."\n";
}
}
}
}
($dprxFH,$stderr)=
Rem_Command::new('Rem_Command',
$Net::FullAuto::FA_Core::DeployFTM_Proxy[0]);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $dprx={
_cmd_handle => $dprxFH,
};print "LINE=".__LINE__."\n";
&ftm_connect($dprx,$destFH->{_hostlabel}->[0]);print "LINE=".__LINE__."\n";
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}
);print "LINE=".__LINE__."\n";
#($output,$stderr)=&ftp(\%dftp,'',
($output,$stderr)=&Rem_Command::ftpcmd(
\%dftp,"cd \"$dest_fdr\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$dprx->{_cmd_handle}}{cd}
=$d_fdr=$dest_fdr;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "move_tarfile() TRYING TO DO PUT (2)\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"move_tarfile() TRYING TO DO PUT (2)\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"move_tarfile() TRYING TO DO PUT (2)\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(
\%dftp,"put transfer$Net::FullAuto::FA_Core::tran[3].tar",
$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');print "LINE=".__LINE__."\n";
$dprx->{_cmd_handle}->prompt("/$prompt\$/");print "LINE=".__LINE__."\n";
$dprx->{_cmd_handle}->cmd('bye');print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='cmd';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;print "LINE=".__LINE__."\n";
last DPH;print "LINE=".__LINE__."\n";
}
}
}
}
} else {
&Net::FullAuto::FA_Core::handle_error("NO FTP PROXY DEFINED");print "LINE=".__LINE__."\n";
}
} else {
File::Copy::copy($destFH->{_work_dirs}->{_tmp}.
"transfer$Net::FullAuto::FA_Core::tran[3].tar",
$dest_fdr)
|| do{ die "copy failed: $!" };print "LINE=".__LINE__."\n";
$d_fdr=$dest_fdr;print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
#print "SHOWWWWWWWWWWWWWWWWW=$shownow\n";print "LINE=".__LINE__."\n";
#print $Net::FullAuto::FA_Core::MRLOG $shownow
# if $Net::FullAuto::FA_Core::log &&
# -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
#print "HOSTNAME FOR DEST=",$destFH->cmd('hostname'),"\n";print "LINE=".__LINE__."\n";
#print "THISHOSTNAME FOR DEST=",$destFH->cmd('hostname'),"\n";print "LINE=".__LINE__."\n";
#print "D_FDR=$d_fdr<== and DEST_FDR=$dest_fdr<==\n";<STDIN>;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
my $tdr='';print "LINE=".__LINE__."\n";
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");print "LINE=".__LINE__."\n";
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr=$destFH->{_work_dirs}->{_tmp}
if $destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
($output,$stderr)=
$destFH->cmd(
"chmod -v 755 ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # chmod it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($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 "LINE=".__LINE__."\n";
#print "WHAT IS THE SHORTCUT HERE=$shortcut\n";sleep 6;print "LINE=".__LINE__."\n";
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";print "LINE=".__LINE__."\n";
my ($output,$stderr)=$destFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";print "LINE=".__LINE__."\n";
my ($output,$stderr)=$destFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
}
}
} 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];print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-3') if $stderr;print "LINE=".__LINE__."\n";
my $tdr='';print "LINE=".__LINE__."\n";
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");print "LINE=".__LINE__."\n";
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr="$destFH->{_work_dirs}->{_tmp}/"
if $destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
my $dtr=($destFH->{_hostlabel}->[0] ne "__Master_${$}__") ? $d_fdr
: $destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
($output,$stderr)=
$destFH->cmd(
"chmod -v 755 ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # chmod it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($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;print "LINE=".__LINE__."\n";
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";print "LINE=".__LINE__."\n";
my ($output,$stderr)=$destFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";print "LINE=".__LINE__."\n";
my ($output,$stderr)=$destFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
}
}
if ($Net::FullAuto::FA_Core::tran[4]) {
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd \"$destFH->{_work_dirs}->{_tmp}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}
=$destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
($output,$stderr)=
$destFH->cwd($destFH->{_work_dirs}->{_tmp});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[2]=0;print "LINE=".__LINE__."\n";
}
} else {
($output,$stderr)=$destFH->cwd( # cd cmd handle to dest folder
$dest_fdr);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
my $tdr='';print "LINE=".__LINE__."\n";
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");print "LINE=".__LINE__."\n";
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr=$destFH->{_work_dirs}->{_tmp}
if $destFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
}
($output,$stderr)=$destFH->cmd("chmod -v 777 ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # chmod it
if ($stderr) {
if (-1<index $stderr,'chmod: ERROR: invalid mode') {
my $l=__LINE__;$l-=3;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $stderr."\nat Line: ".
"$l\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-7');print "LINE=".__LINE__."\n";
}
}
($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;print "LINE=".__LINE__."\n";
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cmd("tar tvf ${d_fdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar");print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cmd($cmd);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";print "LINE=".__LINE__."\n";
my ($output,$stderr)=$destFH->cmd($cmd);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::savetran=1 if $stderr;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;print "LINE=".__LINE__."\n";
}
}
}
}
sub ftm_connect
{
#my $logreset=1;print "LINE=".__LINE__."\n";
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "ftm_connect() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $ftpFH=$_[0];my $hostlabel=$_[1];my $_connect=$_[2]||'';print "LINE=".__LINE__."\n";
my $cache=$_[3]||'';my $ftm_type='';my $ftm_passwd='';print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
my @connect_method=@{$ftr_cnct};print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fctimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$fctimeout) {
$fctimeout=$timeout if !$fctimeout;print "LINE=".__LINE__."\n";
}
my @hosts=();print "LINE=".__LINE__."\n";
if ($use eq 'ip') {
@hosts=($hostname,$ip);print "LINE=".__LINE__."\n";
} else {
@hosts=($ip,$hostname);print "LINE=".__LINE__."\n";
} my $host='';print "LINE=".__LINE__."\n";
if ($ping) {
while (1) {
my $error=0;print "LINE=".__LINE__."\n";
eval {
while ($host=pop @hosts) {
$ftpFH->{_cmd_handle}->print(
$Net::FullAuto::FA_Core::gbp->('ping')."ping $host");print "LINE=".__LINE__."\n";
while (my $line=
$ftpFH->{_cmd_handle}->get(
Timeout=>5)) {
if ($line=~/ from /s) {
#print "TEN003\n";print "LINE=".__LINE__."\n";
$ftpFH->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
while (my $ln=$ftpFH->{_cmd_handle}->get) {
last if $ln=~/_funkyPrompt_$/s;print "LINE=".__LINE__."\n";
} return;print "LINE=".__LINE__."\n";
} elsif (-1<index $line,'NOT FOUND'
|| -1<index $line,'Bad IP') {
if ($line=~/_funkyPrompt_$/s) {
$error=1;return;print "LINE=".__LINE__."\n";
}
}
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
next if $error;print "LINE=".__LINE__."\n";
if (-1<index $@,'read timed-out') {
#print "ELEVEN003\n";print "LINE=".__LINE__."\n";
$ftpFH->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
while (my $ln=$ftpFH->{_cmd_handle}->get) {
last if $ln=~/_funkyPrompt_$/s;print "LINE=".__LINE__."\n";
} return 0;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
($ftpFH->{_cmd_handle}->{_cmd_handle},$stderr)=
&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$@);print "LINE=".__LINE__."\n";
if ($stderr) {
$stderr="$@\n $stderr";print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
} elsif (!$ftpFH->{_cmd_handle}) {
return 0;print "LINE=".__LINE__."\n";
}
($output,$stderr)=$ftpFH->{_cmd_handle}->cmd(
"cd $ftpFH->{_work_dirs}->{_cwd}");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} elsif ($error) {
$error=0;next;print "LINE=".__LINE__."\n";
} last;print "LINE=".__LINE__."\n";
}
} 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 "LINE=".__LINE__."\n";
#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,'*';print "LINE=".__LINE__."\n";
#if ($ftm_passwd ne 'DoNotSU!') {
# $su_login=1;print "LINE=".__LINE__."\n";
#} else { $su_id='' }
$su_id=''
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,'');print "LINE=".__LINE__."\n";
}
$ftpFH->{_cmd_handle}->timeout($fctimeout);print "LINE=".__LINE__."\n";
my $fm_cnt=-1;print "LINE=".__LINE__."\n";
WE: while (1) {
foreach my $connect_method (@connect_method) {
$fm_cnt++;print "LINE=".__LINE__."\n";
if (lc($connect_method) eq 'ftp') {
$ftm_type='ftp';print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
($ftpFH->{_cmd_handle},$stderr)
=&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$stderr);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
@connect_method=();print "LINE=".__LINE__."\n";
@connect_method=@{$ftr_cnct};print "LINE=".__LINE__."\n";
next WE;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-14');print "LINE=".__LINE__."\n";
}
}
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (6)
print "\n Logging into $host ($hostlabel) via ",
"ftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostlabel) via ".
"ftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (6) into $host ($hostlabel) via ",
"ftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging (6) into $host ($hostlabel) via ".
"ftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (6) into $host ($hostlabel) via ",
"ftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";print "LINE=".__LINE__."\n";
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::ftppath}ftp $host");print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftm';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}
=$value;print "LINE=".__LINE__."\n";
last FP;print "LINE=".__LINE__."\n";
}
}
}
}
my $lin='';$stderr='';print "LINE=".__LINE__."\n";
eval {
while (my $line=$ftpFH->{_cmd_handle}->get) {
my $tline=$line;print "LINE=".__LINE__."\n";
$tline=~s/Name.*$//s;print "LINE=".__LINE__."\n";
$lin.=$line;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print $tline;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,$tline])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG $tline
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($lin=~/Name.*[: ]+$/si) {
$ftm_type='ftp';last;print "LINE=".__LINE__."\n";
}
$stderr.=$line;print "LINE=".__LINE__."\n";
if ($lin=~/s*ftp> ?$/s) {
$stderr=~s/^(.*?)(\012|\013)+//s;print "LINE=".__LINE__."\n";
$stderr=~s/s*ftp> ?$//s;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
$ftpFH->{_cmd_handle}->print('bye');print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
}
if ($su_id) {
$ftpFH->{_cmd_handle}->print($su_id);print "LINE=".__LINE__."\n";
} else {
$ftpFH->{_cmd_handle}->print($login_id);print "LINE=".__LINE__."\n";
}
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=&wait_for_passwd_prompt($ftpFH);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
$ftpFH->{_cmd_handle}->print("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
$ftm_type='ftp';last;print "LINE=".__LINE__."\n";
} elsif (lc($connect_method) eq 'sftp') {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});print "LINE=".__LINE__."\n";
if ($cfh_error && $cfh_error ne 'Invalid filehandle') {
#print "YEP GOT TO LOGIN_RETRY<==\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
($ftpFH->{_cmd_handle},$stderr)
=&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$stderr);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
@connect_method=();print "LINE=".__LINE__."\n";
@connect_method=@{$ftr_cnct};print "LINE=".__LINE__."\n";
next WE;print "LINE=".__LINE__."\n";
}
$ftm_type='sftp';print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (7)
print "\n Logging into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (7) into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging (7) into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (7) into $host ($hostlabel) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $sshport='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
if ($su_id) {
$ftpFH->{_cmd_handle}->print(
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$su_id\@$host");print "LINE=".__LINE__."\n";
} else {
$ftpFH->{_cmd_handle}->print(
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$login_id\@$host");print "LINE=".__LINE__."\n";
}
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=&wait_for_passwd_prompt($ftpFH);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
$ftpFH->{_cmd_handle}->print("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
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};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftm';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;print "LINE=".__LINE__."\n";
last SP;print "LINE=".__LINE__."\n";
}
}
}
}
$ftm_type='sftp';last;print "LINE=".__LINE__."\n";
}
} last;print "LINE=".__LINE__."\n";
}
my $die='';my $die_login_id='';my $ftm_errmsg='';print "LINE=".__LINE__."\n";
my $su_login='';my $retrys=0;print "LINE=".__LINE__."\n";
my %ftp=();my @choices=();print "LINE=".__LINE__."\n";
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}
);print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$ftm_passwd,$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
#print "I AM GOING TO TRY AND DO THE PROMPT\n";print "LINE=".__LINE__."\n";
eval {
$ftpFH->{_cmd_handle}->prompt("/s*ftp> ?\$/");print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
#print "GOT PAST THE PROMPT and EVALERR=$@\n";print "LINE=".__LINE__."\n";
################## MAKE NEW SUBROUTINE START HERE
my $lin='';my $asked=0;my $authyes=0;print "LINE=".__LINE__."\n";
while (1) {
$ftpFH->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
while (my $line=$ftpFH->{_cmd_handle}->get) {
#print "LOOKING FOR FTPPROMPTLINE12=$line<==\n";print "LINE=".__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,'*';print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$lin.=$line;print "LINE=".__LINE__."\n";
if ($lin=~/Perm/s && $lin=~/password[: ]+$/si) {
if ($su_id) {
if (!$asked++) {
my $error='';print "LINE=".__LINE__."\n";
($error=$lin)=~s/^\s*(.*)\n.*$/$1/s;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
$choices[0]="Re-enter password and re-attempt with "
."\'$su_id\'";print "LINE=".__LINE__."\n";
$choices[1]="Attempt login with base id \'$login_id\'";print "LINE=".__LINE__."\n";
my $choice=&Menus::pick(\@choices,$banner);print "LINE=".__LINE__."\n";
chomp $choice;print "LINE=".__LINE__."\n";
if ($choice ne ']quit[') {
if ($choice=~/$su_id/s) {
my $show='';print "LINE=".__LINE__."\n";
($show=$lin)=~s/^.*?\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
while (1) {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n$show ";print "LINE=".__LINE__."\n";
my $newpass=<STDIN>;print "LINE=".__LINE__."\n";
chomp $newpass;print "LINE=".__LINE__."\n";
$ftpFH->{_cmd_handle}->print($newpass);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $show
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$lin='';last;print "LINE=".__LINE__."\n";
}
} else {
&Net::FullAuto::FA_Core::su_scrub(
$hostlabel,$su_id,$ftm_type);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::passwd_db_update(
$hostlabel,$su_id,'DoNotSU!',
$ftm_type);print "LINE=".__LINE__."\n";
#print "TWELVE003\n";print "LINE=".__LINE__."\n";
$ftpFH->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$line=~s/\s*$//s;print "LINE=".__LINE__."\n";
last if $line=~/_funkyPrompt_$/s;print "LINE=".__LINE__."\n";
last if $line=~/Killed by signal 2\.$/s;print "LINE=".__LINE__."\n";
}
my $sshport='';print "LINE=".__LINE__."\n";
if (exists
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}) {
$sshport.='-i'.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
$ftpFH->{_cmd_handle}->print(
$Net::FullAuto::FA_Core::gbp->('sftp').
'sftp '."${sshport}$login_id\@$host");print "LINE=".__LINE__."\n";
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=
&wait_for_passwd_prompt($ftpFH);print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
$ftpFH->{_cmd_handle}->("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
## Send password.
#print "444 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";print "LINE=".__LINE__."\n";
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');print "LINE=".__LINE__."\n";
$ftpFH->{_cmd_handle}->print($ftm_passwd);print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (8)
print "\n ",
"Logging into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n ".
"Logging into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n ",
"Logging (8) into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging (8) ".
"into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (8) into $host ($hostlabel) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
} else {
&Net::FullAuto::FA_Core::cleanup();print "LINE=".__LINE__."\n";
}
} elsif ($asked<4) {
#print "YESSSSSSS WE HAVE DONE IT FOUR TIMES22\n";<STDIN>;print "LINE=".__LINE__."\n";
}
} else {
## Send password.
#print "555 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";<STDIN>;print "LINE=".__LINE__."\n";
my $showerr='';print "LINE=".__LINE__."\n";
($showerr=$lin)=~s/^.*?\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
$showerr=~s/^(.*)?\n.*$/$1/s;print "LINE=".__LINE__."\n";
$retrys++;print "LINE=".__LINE__."\n";
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$showerr,'','sftp','__force__');print "LINE=".__LINE__."\n";
$ftpFH->{_cmd_handle}->print($ftm_passwd);print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (9)
print "\n Logging into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n ",
"Logging (9) into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging (9) ".
"into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (9) into $host ($hostlabel) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$lin='';next;print "LINE=".__LINE__."\n";
}
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
my $question=$lin;print "LINE=".__LINE__."\n";
$question=~s/^.*(The authen.*)$/$1/s;print "LINE=".__LINE__."\n";
$question=~s/\' can\'t/\'\ncan\'t/s;print "LINE=".__LINE__."\n";
while (1) {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n$question ";print "LINE=".__LINE__."\n";
my $answer=<STDIN>;print "LINE=".__LINE__."\n";
chomp $answer;print "LINE=".__LINE__."\n";
if (lc($answer) eq 'yes') {
$ftpFH->{_cmd_handle}->print($answer);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$authyes=1;$lin='';last;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::cleanup()
}
}
}
if ($line=~/[\$\%\>\#\-\:]+ ?$/m) {
$lin='';last;print "LINE=".__LINE__."\n";
} elsif ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
$lin='';last;print "LINE=".__LINE__."\n";
} elsif ($lin=~/Perm/s) { last }
}
if ($lin=~/Perm/s) {
$lin=~s/\s*//s;print "LINE=".__LINE__."\n";
$lin=~s/^(.*)?\n.*$/$1/s;print "LINE=".__LINE__."\n";
shift @connect_method;print "LINE=".__LINE__."\n";
die $lin;print "LINE=".__LINE__."\n";
} else { last }
}
################## MAKE NEW SUBROUTINE END HERE
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@=~/ogin incor/ && $retrys<2) {
$retrys++;print "LINE=".__LINE__."\n";
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);print "LINE=".__LINE__."\n";
$die_login_id=$su_id;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$login_id);print "LINE=".__LINE__."\n";
$die_login_id=$login_id;print "LINE=".__LINE__."\n";
}
$ftpFH->{_cmd_handle}->print('bye');print "LINE=".__LINE__."\n";
while (my $line=$ftpFH->{_cmd_handle}->get) {
last if $line=~/_funkyPrompt_$/s;print "LINE=".__LINE__."\n";
}
$ftpFH->{_cmd_handle}->timeout($fctimeout);print "LINE=".__LINE__."\n";
my $sshport='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'identity_file'}) {
$sshport.='-i'.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";print "LINE=".__LINE__."\n";
if ($ftm_type eq 'ftp') {
$ftpFH->{_cmd_handle}->print("${Net::FullAuto::FA_Core::ftppath}ftp $host");print "LINE=".__LINE__."\n";
} elsif ($ftm_type eq 'sftp') {
if ($su_id) {
$ftpFH->{_cmd_handle}->print(
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$su_id\@$host");print "LINE=".__LINE__."\n";
} else {
$ftpFH->{_cmd_handle}->print(
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$login_id\@$host");print "LINE=".__LINE__."\n";
}
}
$ftpFH->{_cmd_handle}->
waitfor(-match => '/Name.*[: ]+$/i');print "LINE=".__LINE__."\n";
$@='';next;print "LINE=".__LINE__."\n";
} elsif ($@) {
my $f_t=$ftm_type;$f_t=~s/^(.)/uc($1)/e;print "LINE=".__LINE__."\n";
$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 $@";print "LINE=".__LINE__."\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);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
$transfer_dir="/cygdrive/$drive$path/";print "LINE=".__LINE__."\n";
}
my ($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$transfer_dir\"",$cache);print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $output) {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print $line;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,$line])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG $line
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
next if $line!~/^\d/;print "LINE=".__LINE__."\n";
if (unpack('a3',$line)!=250) {
my $warn="The FTP Service Cannot Change to "
."the Transfer Directory"
."\n\n -> $line\n";print "LINE=".__LINE__."\n";
warn "$warn $!";return 0;print "LINE=".__LINE__."\n";
}
} $Net::FullAuto::FA_Core::ftpcwd{$ftpFH->{_cmd_handle}}{cd}=$transfer_dir;print "LINE=".__LINE__."\n";
} return 1;print "LINE=".__LINE__."\n";
}
sub dup_Processes
{
my $cmd_handle=$_[0];print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
}
}
}
} return 0;print "LINE=".__LINE__."\n";
}
sub map_mirror
{
my $mirrormap=$_[0];print "LINE=".__LINE__."\n";
my $map='mirrormap';print "LINE=".__LINE__."\n";
my @keys=split '/',"$_[1]";print "LINE=".__LINE__."\n";
my $file="$_[3]";print "LINE=".__LINE__."\n";
my $reason="$_[4]";print "LINE=".__LINE__."\n";
my $num_of_levels=$#keys;print "LINE=".__LINE__."\n";
#print "REASON=$reason\n";print "LINE=".__LINE__."\n";
#print "KEYS=@keys\n";print "LINE=".__LINE__."\n";
#print "NUM_OF_LEVELS=$num_of_levels\n";print "LINE=".__LINE__."\n";
if ($_[1] eq '/') {
eval "\@{\${\$$map}[0]}[0,1,2]=(\'all\',\'/\',\'\')";print "LINE=".__LINE__."\n";
} elsif ($file ne '') {
if ("$_[2]" eq 'EXCLUDE') {
eval "push \@{\${\${\$$map}[0]}[4]}, [ \"\$file\",\"\$reason\" ]";print "LINE=".__LINE__."\n";
} else {
eval "push \@{\${\${\$$map}[0]}[3]}, [ \"\$file\",\"\$reason\" ]";print "LINE=".__LINE__."\n";
}
} else {
my $num_decrement=$num_of_levels;print "LINE=".__LINE__."\n";
my ($exclude,$num,$num_of_elem)='';print "LINE=".__LINE__."\n";
while (-1<$num_decrement--) {
$num_of_elem=eval "\$\#{$map}";print "LINE=".__LINE__."\n";
$num_of_elem=0 if $num_of_elem==-1;print "LINE=".__LINE__."\n";
$map.="\}\[$num_of_elem\]";print "LINE=".__LINE__."\n";
$map="\$\{$map";print "LINE=".__LINE__."\n";
$num++;print "LINE=".__LINE__."\n";
#print "NUM=$num and KEYS=$#keys\n";print "LINE=".__LINE__."\n";
if ("$_[2]" eq 'EXCLUDE') {
#print "MAPP1=$map and $keys[$num]\n";print "LINE=".__LINE__."\n";
eval "\@{\${\$$map}[0]}[0]=\'some\'";print "LINE=".__LINE__."\n";
#print "MIRRORMAP=$mirrormap and THIS=${${${$mirrormap}[0]}[0]}[0]\n";<STDIN>;print "LINE=".__LINE__."\n";
# print "GOT THE GOODS=",eval "\@{\${\$$map}[0]}[2]","\n";print "LINE=".__LINE__."\n";
if (eval "\${\${\$$map}[0]}[2]" eq 'EXCLUDE') {
$exclude='EXCLUDE';print "LINE=".__LINE__."\n";
}
} elsif ($#keys==$num) {
eval "\@{\${\$$map}[0]}[0,1,2]=(\'all\',\'$keys[$num]\',\'\')";print "LINE=".__LINE__."\n";
#print "MIRRORMAP=$mirrormap and THIS=${${${$mirrormap}[0]}[0]}[0]\n";<STDIN>;print "LINE=".__LINE__."\n";
}
}
}
return $mirrormap;print "LINE=".__LINE__."\n";
}
#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>;print "LINE=".__LINE__."\n";
# $trantar=move_files($baseFH,"$key",
# \@files,$dest_fdr,
# $destFH,$bms_share,$dms_share,
# '',$local_transfer_dir,$trantar,
# $bhostlabel,$dhostlabel,'',
# $shortcut,\%desthash);print "LINE=".__LINE__."\n";
sub move_files
{
#print "MOVE_FILESCALLER=",caller,"\n";<STDIN>;print "LINE=".__LINE__."\n";
my ($baseFH,$key,$file,$dest_fdr,
$destFH,$bms_share,$dms_share,$nosubs,
$local_transfer_dir,$trantar,$bhostlabel,
$dhostlabel,$parentkey,$shortcut) = @_;print "LINE=".__LINE__."\n";
#print "BASEFH=$baseFH\n";print "LINE=".__LINE__."\n";
#print "KEY=$key\n";print "LINE=".__LINE__."\n";
#print "FILE=$file\n";print "LINE=".__LINE__."\n";
#print "DEST_FDR=$dest_fdr\n";print "LINE=".__LINE__."\n";
#print "DESTFH=$destFH\n";print "LINE=".__LINE__."\n";
#print "BMS_SHARE=$bms_share\n";print "LINE=".__LINE__."\n";
#print "DMS_SHARE=$dms_share\n";print "LINE=".__LINE__."\n";
#print "NOSUBS=$nosubs\n";print "LINE=".__LINE__."\n";
#print "LOCALTRANSFERDIR=$local_transfer_dir\n";print "LINE=".__LINE__."\n";
#print "TRANTAR=$trantar\n";print "LINE=".__LINE__."\n";
#print "BHOSTLABEL=$bhostlabel\n";print "LINE=".__LINE__."\n";
#print "DHOSTLABEL=$dhostlabel\n";<STDIN>;print "LINE=".__LINE__."\n";
my $basefile='';my $basedir='';my $destdir='';my $msprxFH='';print "LINE=".__LINE__."\n";
my $w32copy='';my $output='';my $stderr='';my $destd='';my $baseprx='';print "LINE=".__LINE__."\n";
if ($bms_share || $baseFH->{_uname} eq 'cygwin') {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd}$key";print "LINE=".__LINE__."\n";
} $basedir.='/' if $file;print "LINE=".__LINE__."\n";
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
if ((exists $destFH->{_smb})
&& (exists $baseFH->{_smb})) {
#print "HEREEEEEEEEE1\n";print "LINE=".__LINE__."\n";
$msprxFH=$destFH;print "LINE=".__LINE__."\n";
} elsif (exists $baseFH->{_smb}) {
$msprxFH=$baseFH;print "LINE=".__LINE__."\n";
} elsif ($dhostlabel ne "__Master_${$}__") {
&Net::FullAuto::FA_Core::handle_error('NO Microsoft OS Proxy Host Defined');print "LINE=".__LINE__."\n";
}
if ($dhostlabel ne "__Master_${$}__") {
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$key";print "LINE=".__LINE__."\n";
} $destdir.='/' if $file;print "LINE=".__LINE__."\n";
} elsif (unpack('a1',$dest_fdr) eq '/') {
my $testd=&test_dir($destFH->{_cmd_handle},$dest_fdr);print "LINE=".__LINE__."\n";
if ($destFH->{_uname} eq 'cygwin') {
my $testd=&test_dir($destFH->{_cmd_handle},$dest_fdr);print "LINE=".__LINE__."\n";
if ($testd ne 'WRITE') {
if ($testd eq 'NODIR') {
my $destdir_mswin='';print "LINE=".__LINE__."\n";
($destdir,$destdir_mswin)
=&File_Transfer::get_drive($dest_fdr,'Destination',
'',$dhostlabel);print "LINE=".__LINE__."\n";
($output,$stderr)=$destFH->cwd($destdir);print "LINE=".__LINE__."\n";
my $die="Destination Directory $dest_fdr\n"
.' Does NOT Exist!:\n\n '
.$stderr;print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
} else {
my $die="Destination Directory $dest_fdr\n"
.' is NOT Writable!';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
}
$dest_fdr=&Net::FullAuto::FA_Core::attempt_cmd_xtimes($destFH,
'cmd /c chdir',$dhostlabel);print "LINE=".__LINE__."\n";
$dest_fdr=unpack('a2',$dest_fdr);print "LINE=".__LINE__."\n";
$dest_fdr=~tr/\\/\//;print "LINE=".__LINE__."\n";
} elsif ($testd ne 'WRITE') {
if ($testd eq 'NODIR') {
my $die="Destination Directory $dest_fdr\n"
.' Does NOT Exist!';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
} else {
my $die="Destination Directory $dest_fdr\n"
.' is NOT Writable!';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$die;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
}
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$destdir/$key";print "LINE=".__LINE__."\n";
} $destdir.='/' if $file;print "LINE=".__LINE__."\n";
} elsif (unpack('x1 a1',$dest_fdr) eq ':') {
$destFH->{_work_dirs}->{_pre}=
$destFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
$destFH->{_work_dirs}->{_pre_mswin}=
$destFH->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
my ($drive,$path)=unpack('a1 x1 a*',$dest_fdr);print "LINE=".__LINE__."\n";
$path=~tr/\\/\//;print "LINE=".__LINE__."\n";
$destFH->{_work_dirs}->{_cwd_mswin}=$dest_fdr;print "LINE=".__LINE__."\n";
$destFH->{_work_dirs}->{_cwd}=$destFH->{_cygdrive}
.'/'.lc($drive).$path.'/';print "LINE=".__LINE__."\n";
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};print "LINE=".__LINE__."\n";
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$key";print "LINE=".__LINE__."\n";
} $destdir.='/' if $file;print "LINE=".__LINE__."\n";
} else {
if ($key eq '/') {
$destdir=$destFH->cmd('pwd');print "LINE=".__LINE__."\n";
} else {
$destdir=$destFH->cmd('pwd')."/$key";print "LINE=".__LINE__."\n";
} $destdir.='/' if $file;print "LINE=".__LINE__."\n";
$destdir=~tr/\\/\//;print "LINE=".__LINE__."\n";
}
} else {
if ((exists $baseFH->{_smb}) ||
$baseFH->{_uname} eq 'cygwin') {
$msprxFH=$baseFH;print "LINE=".__LINE__."\n";
} elsif ($bhostlabel ne "__Master_${$}__") {
&Net::FullAuto::FA_Core::handle_error(
'NO Microsoft OS Proxy Host Defined');print "LINE=".__LINE__."\n";
}
if ($destFH->{_work_dirs}->{_tmp}) {
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
} else {
$destdir="$destFH->{_work_dirs}->{_cwd_mswin}$key";print "LINE=".__LINE__."\n";
} $destdir.='/' if $file;print "LINE=".__LINE__."\n";
} elsif ($key ne '/') {
$destdir=$key;print "LINE=".__LINE__."\n";
}
$trantar=1;print "LINE=".__LINE__."\n";
}
} elsif ($dms_share) {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd_mswin}$key";print "LINE=".__LINE__."\n";
$destdir="$destFH->{_work_dirs}->{_cwd_mswin}$key";print "LINE=".__LINE__."\n";
} $basedir.='/' if $file;print "LINE=".__LINE__."\n";
$destdir.='/' if $file;print "LINE=".__LINE__."\n";
$destdir=~tr/\//\\/;print "LINE=".__LINE__."\n";
$destdir=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
if (exists $destFH->{_smb}) {
$msprxFH=$destFH;print "LINE=".__LINE__."\n";
} elsif ($dhostlabel ne "__Master_${$}__") {
&Net::FullAuto::FA_Core::handle_error(
'NO Microsoft OS Proxy Host Defined');print "LINE=".__LINE__."\n";
}
} else {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd_mswin}$key";print "LINE=".__LINE__."\n";
} $basedir.='/' if $file;print "LINE=".__LINE__."\n";
$destdir=$key;$trantar=1;print "LINE=".__LINE__."\n";
}
my $b_OS='';my $m_OS='';my $d_OS='';my $FH='';print "LINE=".__LINE__."\n";
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';print "LINE=".__LINE__."\n";
} else {
$b_OS=$m_OS='cygwin';print "LINE=".__LINE__."\n";
$d_OS='Unix';print "LINE=".__LINE__."\n";
} $msprxFH=$Net::FullAuto::FA_Core::localhost;print "LINE=".__LINE__."\n";
} elsif ($dms_share) {
$m_OS=$d_OS='cygwin';print "LINE=".__LINE__."\n";
$b_OS='Unix';print "LINE=".__LINE__."\n";
#print "HEREEEEEEEEE7\n";print "LINE=".__LINE__."\n";
$msprxFH=$Net::FullAuto::FA_Core::localhost;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]="__Master_${$}__";print "LINE=".__LINE__."\n";
if ($msprxFH->{_work_dirs}->{_tmp}) {
my ($output,$stderr)=$msprxFH->cwd(
$msprxFH->{_work_dirs}->{_tmp});print "LINE=".__LINE__."\n";
if ($stderr) {
@FA_Core::tran=();print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> "
."$msprxFH->{_work_dirs}->{_tmp}\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-6');print "LINE=".__LINE__."\n";
} $Net::FullAuto::FA_Core::tran[0]=$msprxFH->{_work_dirs}->{_tmp};print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::tran[0]=$msprxFH->cmd('pwd');print "LINE=".__LINE__."\n";
}
} else {
$m_OS='cygwin';print "LINE=".__LINE__."\n";
$b_OS=$d_OS='Unix';print "LINE=".__LINE__."\n";
}
} else {
if ($bms_share || $baseFH->{_uname} eq 'cygwin') {
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
$b_OS=$d_OS='cygwin';print "LINE=".__LINE__."\n";
$m_OS='UNIX';print "LINE=".__LINE__."\n";
#print "HEREEEEEEEEE8\n";print "LINE=".__LINE__."\n";
$msprxFH=$baseFH;print "LINE=".__LINE__."\n";
} else {
$b_OS='cygwin';print "LINE=".__LINE__."\n";
$m_OS=$d_OS='Unix';print "LINE=".__LINE__."\n";
}
} elsif ($dms_share) {
$d_OS='cygwin';print "LINE=".__LINE__."\n";
$b_OS=$m_OS='Unix';print "LINE=".__LINE__."\n";
#print "HEREEEEEEEEE9\n";print "LINE=".__LINE__."\n";
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
} else {
$b_OS=$m_OS=$d_OS='Unix';print "LINE=".__LINE__."\n";
}
}
#if ($msprxFH) {
# ($output,$stderr)=$msprxFH->cmd('cp','__notrap__');print "LINE=".__LINE__."\n";
# if (unpack('a11',$stderr) ne 'cp: missing') {
# $w32copy=1;print "LINE=".__LINE__."\n";
# }
#}
&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';print "LINE=".__LINE__."\n";
return $trantar;print "LINE=".__LINE__."\n";
}
sub move_file_list
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
#print "MOVEFILELISTCALLER=",(join ' ',@topcaller),"\n"
# if !$Net::FullAuto::FA_Core::cron &&
# $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
my ($file,$basedir,$destdir,$msprxFH,$baseFH,
$destFH,$key,$w32copy,$local_transfer_dir,
$b_OS,$m_OS,$d_OS,$parentkey,$shortcut)=@_;print "LINE=".__LINE__."\n";
#print "BASEDIR=$basedir<===\n";#<STDIN>;print "LINE=".__LINE__."\n";
my $farg='';my $filearg='';my $proxydir='';print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
$farg.="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";print "LINE=".__LINE__."\n";
if (1500<length "$farg$destdir") {
$filearg=~tr/\\/\//;print "LINE=".__LINE__."\n";
$destdir.=$key if $key;print "LINE=".__LINE__."\n";
$destdir=~tr/\\/\//;print "LINE=".__LINE__."\n";
chop $filearg;print "LINE=".__LINE__."\n";
my $td="--target-directory=$destdir";print "LINE=".__LINE__."\n";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap_');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($msprxFH);print "LINE=".__LINE__."\n";
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
'',$msprxFH,'')
}
}
$farg="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";print "LINE=".__LINE__."\n";
} $filearg=$farg;print "LINE=".__LINE__."\n";
}
if ($filearg) {
$filearg=~tr/\\/\//;print "LINE=".__LINE__."\n";
$destdir=~tr/\\/\//;print "LINE=".__LINE__."\n";
chop $filearg;print "LINE=".__LINE__."\n";
my $td="--target-directory=$destdir";print "LINE=".__LINE__."\n";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($msprxFH);print "LINE=".__LINE__."\n";
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\"";print "LINE=".__LINE__."\n";
} else {
$proxydir="\".\\transfer$Net::FullAuto::FA_Core::tran[3]$parentkey\"";print "LINE=".__LINE__."\n";
}
$proxydir=~tr/\\/\//;print "LINE=".__LINE__."\n";
my $td="--target-directory=$proxydir";print "LINE=".__LINE__."\n";
if ($file) {
foreach my $fil (@{$file}) {
$fil=~s/%/\\%/g;print "LINE=".__LINE__."\n";
$farg.="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";print "LINE=".__LINE__."\n";
if (1500<length "$farg$proxydir") {
$filearg=~tr/\\/\//;print "LINE=".__LINE__."\n";
chop $filearg;print "LINE=".__LINE__."\n";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($msprxFH);print "LINE=".__LINE__."\n";
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$proxydir,$msprxFH,'')
}
}
$farg="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";print "LINE=".__LINE__."\n";
} $filearg=$farg;print "LINE=".__LINE__."\n";
}
if ($filearg) {
$filearg=~tr/\\/\//;print "LINE=".__LINE__."\n";
chop $filearg;print "LINE=".__LINE__."\n";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($msprxFH);print "LINE=".__LINE__."\n";
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='';print "LINE=".__LINE__."\n";
$fdot='/.' if $key eq '/';print "LINE=".__LINE__."\n";
#$filearg.="\'$baseFH->{_work_dirs}->[0]$basedir$fdot\'";print "LINE=".__LINE__."\n";
$filearg.="\'$baseFH->{_work_dirs}->{_cwd}$fdot\'";print "LINE=".__LINE__."\n";
$filearg=~tr/\\/\//;print "LINE=".__LINE__."\n";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -Rfpv $filearg $td",'__notrap__');print "LINE=".__LINE__."\n";
if ($stderr) {
&clean_process_files($msprxFH);print "LINE=".__LINE__."\n";
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/\\/\//;print "LINE=".__LINE__."\n";
my $td.=$destdir;print "LINE=".__LINE__."\n";
$td="--target-directory=$td";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -Rfpv ./transfer".
"$Net::FullAuto::FA_Core::tran[3]/* \"$td\"");print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-7');print "LINE=".__LINE__."\n";
}
}
}
}
sub clean_process_files
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "CLEAN_PROCESS_FILES-CALLER=",
(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
my $pid_ts=pop @FA_Core::pid_ts;print "LINE=".__LINE__."\n";
$pid_ts||='';return '','' if !$pid_ts;print "LINE=".__LINE__."\n";
my $str="echo \"del rm${pid_ts}.bat\"";print "LINE=".__LINE__."\n";
my $output='';my $stderr='';print "LINE=".__LINE__."\n";
$str.=" >> rm${pid_ts}.bat";print "LINE=".__LINE__."\n";
($output,$stderr)=$self->cmd($str);print "LINE=".__LINE__."\n";
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;print "LINE=".__LINE__."\n";
my $die= "$stderr\n\n From Command -> " . "\"$str\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
if ($self->{_uname} eq 'cygwin') {
$output=join '',$self->{_cmd_handle}->cmd(
"cmd /c rm${pid_ts}.bat");print "LINE=".__LINE__."\n";
} else {
$output=join '',$self->{_cmd_handle}->{_cmd_handle}->cmd(
"cmd /c rm${pid_ts}.bat");print "LINE=".__LINE__."\n";
}
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;print "LINE=".__LINE__."\n";
my $die="$stderr\n\n From Command -> "
."\"cmd /c rm${pid_ts}.bat\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
sub move_MSWin_stderr
{
#print "MSWin_stderrCALLER=",caller,"\n";print "LINE=".__LINE__."\n";
my ($stderr,$filearg,$destdir,$FH,$option)=@_;print "LINE=".__LINE__."\n";
my $output='';print "LINE=".__LINE__."\n";
if (!$stderr || (-1<index $stderr,"No such file")
|| (-1<index $stderr,"not a directory")) {
my $destd='';print "LINE=".__LINE__."\n";
if (unpack('a10',$destdir) eq '/cygdrive/') {
$destd=unpack('x10 a*',$destdir);print "LINE=".__LINE__."\n";
$destd=~s/^(.)/$1:/;print "LINE=".__LINE__."\n";
} else { $destd=$destdir }
$destd=~tr/\//\\/;print "LINE=".__LINE__."\n";
$stderr='';print "LINE=".__LINE__."\n";
($output,$stderr)=$FH->cmd(
"cmd /c mkdir \"$destd\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr
&& (-1==index $stderr,'already exists');print "LINE=".__LINE__."\n";
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]";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]= ($FH->{_hostlabel}->[1]) ?
$FH->{_hostlabel}->[1] : $FH->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[4]=1;print "LINE=".__LINE__."\n";
} return if !$filearg;print "LINE=".__LINE__."\n";
$stderr='';print "LINE=".__LINE__."\n";
my $td="--target-directory=$destdir";print "LINE=".__LINE__."\n";
my $e_cnt=0;print "LINE=".__LINE__."\n";
($output,$stderr)=$FH->cmd(
"cmd /c cp -${option}fpv $filearg $td");print "LINE=".__LINE__."\n";
if ($stderr) {
my $subwarn="WARNING! COPY ERROR";print "LINE=".__LINE__."\n";
my %mail=(
'Body' => "$stderr",
'Subject' => "$subwarn AND \$filearg=$filearg"
);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::send_email(\%mail);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $stderr
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-12') if $stderr
&& (-1==index $stderr,'already exists');print "LINE=".__LINE__."\n";
}
} else {
print $Net::FullAuto::FA_Core::MRLOG $stderr
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1');print "LINE=".__LINE__."\n";
}
}
sub build_mirror_hashes
{
my $hostlabel='';print "LINE=".__LINE__."\n";
my $timehash={};my $num_of_files=0;my $num_of_basefiles=0;print "LINE=".__LINE__."\n";
my $timekey='';my $deploy_needed=0;my $output='';print "LINE=".__LINE__."\n";
my $baseFH=$_[0];print "LINE=".__LINE__."\n";
my $destFH=$_[1];print "LINE=".__LINE__."\n";
my $bhostlabel=$_[2];print "LINE=".__LINE__."\n";
my $dhostlabel=$_[3];print "LINE=".__LINE__."\n";
my $verbose=$_[4];print "LINE=".__LINE__."\n";
my $cache=$_[5];print "LINE=".__LINE__."\n";
my $base_uname='';print "LINE=".__LINE__."\n";
my $dest_uname='';print "LINE=".__LINE__."\n";
my $base_windows_daylight_savings=0;print "LINE=".__LINE__."\n";
my $dest_windows_daylight_savings=0;print "LINE=".__LINE__."\n";
my $stdout='';print "LINE=".__LINE__."\n";
my $stderr='';print "LINE=".__LINE__."\n";
my $deploy_empty_dir=0;print "LINE=".__LINE__."\n";
my $dest_dir_status='';print "LINE=".__LINE__."\n";
my $deploy_info='';print "LINE=".__LINE__."\n";
my $debug_info='';print "LINE=".__LINE__."\n";
eval {
$num_of_files=${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"}
if exists ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"};print "LINE=".__LINE__."\n";
delete ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"};print "LINE=".__LINE__."\n";
$num_of_basefiles=
${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"}
if exists ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"};print "LINE=".__LINE__."\n";
delete ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"};print "LINE=".__LINE__."\n";
delete ${$destFH->{_dhash}}{"___%EXCluD%E--NUMOFFILES"};print "LINE=".__LINE__."\n";
delete ${$destFH->{_dhash}}{"___%EXCluD%E--NUMOFBASEFILES"};print "LINE=".__LINE__."\n";
if ($num_of_files) {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "mirror() NUM_OF_FILES=$num_of_files\n",
"mirror() NUM_OF_BASEFILES=$num_of_basefiles\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"mirror() NUM_OF_FILES=$num_of_files\n".
"mirror() NUM_OF_BASEFILES=$num_of_basefiles\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
}
foreach my $key (sort keys %{$baseFH->{_bhash}}) {
next if ${$baseFH->{_bhash}}{$key}[0] eq 'EXCLUDE';print "LINE=".__LINE__."\n";
my @keys=();print "LINE=".__LINE__."\n";
if (${$baseFH->{_bhash}}{$key}[2] eq 'DEPLOY_NOFILES_OF_CURDIR') {
${$baseFH->{_bhash}}{$key}[0]='SOME';print "LINE=".__LINE__."\n";
if (-1<index $key,'/') {
my $chkkey=$key;print "LINE=".__LINE__."\n";
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;print "LINE=".__LINE__."\n";
last if -1==index $chkkey,'/';print "LINE=".__LINE__."\n";
}
} unshift @keys, '/';print "LINE=".__LINE__."\n";
foreach my $key (@keys) {
${$baseFH->{_bhash}}{$key}[0]='SOME';print "LINE=".__LINE__."\n";
} next
}
my $dest_dir_status='';print "LINE=".__LINE__."\n";
if ($key ne '/') {
if (-1==$#keys) {
if (-1<index $key,'/') {
my $chkkey=$key;print "LINE=".__LINE__."\n";
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;print "LINE=".__LINE__."\n";
last if -1==index $chkkey,'/';print "LINE=".__LINE__."\n";
}
} unshift @keys, '/';print "LINE=".__LINE__."\n";
}
if (!exists ${$destFH->{_dhash}}{$key}) {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "mirror() ERROR: WHAT IS THE BAD KEY==>$key<==\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"mirror() ERROR: WHAT IS THE BAD KEY==>$key<==\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
#print "HERE1=$key\n";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE3\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[3]='NOT_ON_DEST';print "LINE=".__LINE__."\n";
$dest_dir_status='DIR_NOT_ON_DEST';print "LINE=".__LINE__."\n";
$deploy_info.=" DEPLOY EMPTY DIR $key - DIR_NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY EMPTY DIR $key - DIR_NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$deploy_empty_dir=$deploy_needed=1;print "LINE=".__LINE__."\n";
} else {
#print "HERE2=$key\n";print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[3]='DIR_ON_DEST';print "LINE=".__LINE__."\n";
$dest_dir_status='DIR_ON_DEST';print "LINE=".__LINE__."\n";
}
}
my $skip=0;my $deploy=0;print "LINE=".__LINE__."\n";
foreach my $file (sort keys %{${$baseFH->{_bhash}}{$key}[1]}) {
#if ($key=~/yglasa/) {
#print "DEST_DIR_STATUS=$dest_dir_status and KEY=$key\n";print "LINE=".__LINE__."\n";
#print "FILE=$file and BASEHASH=",
# @{${$baseFH->{_bhash}}{$key}[1]{$file}},"<==\n";print "LINE=".__LINE__."\n";
#print "DESTHASH=",${$destFH->{_dhash}}{$key}[1]{$file},"\n" if exists
# ${$destFH->{_dhash}}{$key}[1]{$file};<STDIN>;print "LINE=".__LINE__."\n";
#}
if (${$baseFH->{_bhash}}{$key}[1]{$file}[0] eq 'EXCLUDE') {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "mirror() SKIP1=> KEY=$key and FILE=$file\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"mirror() SKIP1=> KEY=$key and FILE=$file\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
if ($key eq '/') {
$debug_info.="SKIP FILE $file - EXCLUDED_BY_FILTER\n";print "LINE=".__LINE__."\n";
} else {
$debug_info.="SKIP FILE $key/$file - EXCLUDED_BY_FILTER\n";print "LINE=".__LINE__."\n";
}
$skip=1;next;print "LINE=".__LINE__."\n";
} my $dchmod='';my $dtime='';my $dyear='';my $dsize='';print "LINE=".__LINE__."\n";
my $dtime1='';my $dtime2='';my $dtime3='';print "LINE=".__LINE__."\n";
my $y=qr(\d\d\d\d|0);my $k=qr(\s+\d+\s+\d+|\s+--\s+--);print "LINE=".__LINE__."\n";
if (exists ${$destFH->{_dhash}}{$key}[1]{$file}) {
if ((!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose) {
print "mirror() DEST_FILE_DATA_STRING=",
${${$destFH->{_dhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND DIRECTORY=$key\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"mirror() DEST_FILE_DATA_STRING=".
${${$destFH->{_dhash}}{$key}[1]{$file}}[1].
" and FILE=$file AND DIRECTORY=$key\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"mirror() DEST_FILE_DATA_STRING=",
${${$destFH->{_dhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND DIRECTORY=$key\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
${${$destFH->{_dhash}}{$key}[1]{$file}}[1]=~
/^(\d+\s+)(\d+)($k)\s+($y)\s+(\d+)\s*(\d*)*\s*$/;print "LINE=".__LINE__."\n";
$dtime1=$1||0;$dtime2=$2||0;$dtime3=$3||0;print "LINE=".__LINE__."\n";
$dyear=$4||0;$dsize=$5||0;$dchmod=$6||0;print "LINE=".__LINE__."\n";
$dtime2="0$dtime2" if length $dtime2==1;print "LINE=".__LINE__."\n";
$dtime=$dtime1.$dtime2.$dtime3;print "LINE=".__LINE__."\n";
$dchmod||='';print "LINE=".__LINE__."\n";
}
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1]=~
/^(\d+\s+)(\d+)($k)\s+($y)\s+(\d+)\s*(\d*)*\s*$/;print "LINE=".__LINE__."\n";
my $btime1=$1||0;my $btime2=$2||0;print "LINE=".__LINE__."\n";
my $btime3=$3||0;print "LINE=".__LINE__."\n";
my $byear=$4||0;my $bsize=$5||0;my $bchmod=$6||0;print "LINE=".__LINE__."\n";
$btime2="0$btime2" if length $btime2==1;print "LINE=".__LINE__."\n";
my $btime=$btime1.$btime2.$btime3;print "LINE=".__LINE__."\n";
$bchmod||='';print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose) {
print "mirror() BASE_FILE_DATA_STRING=",
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND DIRECTORY=$key\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"mirror() BASE_FILE_DATA_STRING=".
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1].
" and FILE=$file AND DIRECTORY=$key\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"mirror() BASE_FILE_DATA_STRING=",
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND DIRECTORY=$key\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($dest_dir_status eq 'DIR_NOT_ON_DEST') {
if ($key eq '/') {
$deploy_info.=" DEPLOY FILE $file - DIR_NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY FILE $file - DIR_NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
if (99<length "$key/$file") {
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE7\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{$file}=$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=$file;print "LINE=".__LINE__."\n";
}
} else {
$deploy_info.=
" DEPLOY FILE $key/$file - DIR_NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY FILE $key/$file - DIR_NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
if (99<length "$key/$file") {
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE8\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";print "LINE=".__LINE__."\n";
}
}
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE4\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
#print "HERE3=$key\n";print "LINE=".__LINE__."\n";
#print "DESTKEYS=",keys %{$destFH->{_dhash}},"\n";<STDIN>;print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="NOT_ON_DEST $bsize $dsize";print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose) {
print "mirror() DEPLOY NEEDED for KEY=$key and ",
"FILE=$file because DIR_NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"mirror() DEPLOY NEEDED for KEY=$key and ".
"FILE=$file because DIR_NOT_ON_DEST\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG "DO WEX REALLY GET HERE5\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$deploy_needed=$deploy=1;print "LINE=".__LINE__."\n";
$btime=~tr/ //;print "LINE=".__LINE__."\n";
if ($key ne '/') {
$timekey="$key/$file";print "LINE=".__LINE__."\n";
} else { $timekey=$file }
if ((!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose) {
print "UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ".
"and BYEAR=$byear and BTIME=$btime\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
$timehash->{$timekey}=[$byear,$btime];print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
if (exists ${$destFH->{_dhash}}{$key}[1]{$file}) {
if ($bsize ne $dsize) {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="DIFF_SIZE $bsize $dsize";print "LINE=".__LINE__."\n";
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(a) $file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(a) $file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=" DEPLOY $file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(b) $key/$file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(b) $key/$file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=" DEPLOY $key/$file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $key/$file - DIFF_SIZE\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";print "LINE=".__LINE__."\n";
}
}
if ((!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose) {
print "DEPLOY NEEDED for KEY=$key and FILE=$file ",
"because DIFF SIZE BSIZE=$bsize and DSIZE=$dsize\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"DEPLOY NEEDED for KEY=$key and FILE=$file ".
"because DIFF SIZE BSIZE=$bsize and DSIZE=$dsize\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
$deploy_needed=$deploy=1;print "LINE=".__LINE__."\n";
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';print "LINE=".__LINE__."\n";
$btime=~tr/ //;print "LINE=".__LINE__."\n";
if ($key ne '/') {
$timekey="$key/$file";print "LINE=".__LINE__."\n";
} else { $timekey=$file }
if ((!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose) {
print "UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ".
"and BYEAR=$byear and BTIME=$btime\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
${$timehash}{$timekey}=[$byear,$btime];print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
my ($bmndy,$bhr,$bmt)
=unpack('a5 x1 a2 x1 a2',$btime);print "LINE=".__LINE__."\n";
my ($dmndy,$dhr,$dmt)
=unpack('a5 x1 a2 x1 a2',$dtime);print "LINE=".__LINE__."\n";
if ($btime ne $dtime) {
my $btim=unpack('x6 a2',$btime);print "LINE=".__LINE__."\n";
my $dtim=unpack('x6 a2',$dtime);print "LINE=".__LINE__."\n";
my $testdhr=$dtime;print "LINE=".__LINE__."\n";
my $testbhr=$btime;print "LINE=".__LINE__."\n";
if ($btim eq '--' || $dtim eq '--') {
substr($testdhr,6,2)='12';print "LINE=".__LINE__."\n";
substr($testbhr,6,2)='12';print "LINE=".__LINE__."\n";
substr($testdhr,9,2)='00';print "LINE=".__LINE__."\n";
substr($testbhr,9,2)='00';print "LINE=".__LINE__."\n";
substr($btime,6,2)='12';print "LINE=".__LINE__."\n";
substr($dtime,6,2)='12';print "LINE=".__LINE__."\n";
substr($btime,9,2)='00';print "LINE=".__LINE__."\n";
substr($dtime,9,2)='00';print "LINE=".__LINE__."\n";
$dtim=0;$btim=0;print "LINE=".__LINE__."\n";
} else {
my $btme=$btime;print "LINE=".__LINE__."\n";
my $dtme=$dtime;print "LINE=".__LINE__."\n";
substr($btme,6,2)='';print "LINE=".__LINE__."\n";
substr($dtme,6,2)='';print "LINE=".__LINE__."\n";
my $testnum='';print "LINE=".__LINE__."\n";
if ($dtim<$btim) {
$testnum=$btim-$dtim;print "LINE=".__LINE__."\n";
} else { $testnum=$dtim-$btim }
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;print "LINE=".__LINE__."\n";
if ($dhr eq '23') {
substr($testdhr,6,2)='01';print "LINE=".__LINE__."\n";
} else {
my $ddhr=$dhr+1;print "LINE=".__LINE__."\n";
$ddhr='0'.$ddhr if length $ddhr==1;print "LINE=".__LINE__."\n";
substr($testdhr,6,2)=$ddhr;print "LINE=".__LINE__."\n";
}
if ($bhr eq '23') {
substr($testbhr,6,2)='01';print "LINE=".__LINE__."\n";
} else {
my $bbhr=$bhr+1;print "LINE=".__LINE__."\n";
$bbhr='0'.$bbhr if length $bbhr==1;print "LINE=".__LINE__."\n";
substr($testbhr,6,2)=$bbhr;print "LINE=".__LINE__."\n";
}
}
my $dff=$btim-$dtim;print "LINE=".__LINE__."\n";
$dff*=-1 if $dff<0;print "LINE=".__LINE__."\n";
$dest_uname=$destFH->{_uname} unless $dest_uname;print "LINE=".__LINE__."\n";
if ($dest_uname eq 'cygwin' && $dff==1) {
my $key_dir=($key ne '/')?"$key/":'';print "LINE=".__LINE__."\n";
($stdout,$stderr)=$destFH->cmd(
"stat \"$key_dir$file\"");print "LINE=".__LINE__."\n";
my $isto=(index $stdout,'Modify: ')+19;print "LINE=".__LINE__."\n";
$stdout=unpack("x$isto a2",$stdout);print "LINE=".__LINE__."\n";
my $st=unpack('x6 a2',
${${$destFH->{_dhash}}{$key}[1]{$file}}[1]);print "LINE=".__LINE__."\n";
$dest_windows_daylight_savings=($st ne $stdout)?1:0;print "LINE=".__LINE__."\n";
}
$base_uname=$baseFH->{_uname} unless $base_uname;print "LINE=".__LINE__."\n";
if ($base_uname eq 'cygwin' && $dff==1) {
my $key_dir=($key ne '/')?"$key/":'';print "LINE=".__LINE__."\n";
($stdout,$stderr)=$baseFH->cmd("stat \"$key_dir$file\"");print "LINE=".__LINE__."\n";
my $isto=(index $stdout,'Modify: ')+19;print "LINE=".__LINE__."\n";
$stdout=unpack("x$isto a2",$stdout);print "LINE=".__LINE__."\n";
my $st=unpack('x6 a2',
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1]);print "LINE=".__LINE__."\n";
$base_windows_daylight_savings=($st ne $stdout)?1:0;print "LINE=".__LINE__."\n";
}
my $bddd=$base_windows_daylight_savings-
$dest_windows_daylight_savings;print "LINE=".__LINE__."\n";
$bddd*=-1 if $bddd<0;print "LINE=".__LINE__."\n";
if ((!$btim && !$dtim) || ($dff==1 && $bddd==1)) {
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';print "LINE=".__LINE__."\n";
$skip=1;print "LINE=".__LINE__."\n";
if ($key eq '/') {
$debug_info.=
"SKIP FILE $file - SAME_SIZE_TIME_STAMP1\n";print "LINE=".__LINE__."\n";
} else {
$debug_info.=
"SKIP FILE $key/$file - SAME_SIZE_TIME_STAMP1\n";print "LINE=".__LINE__."\n";
}
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="SAME $btime $bsize";print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(c) $file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(c) $file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=" DEPLOY $file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=
" DEPLOY(d) $key/$file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(d) $key/$file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=
" DEPLOY $key/$file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $key/$file - NEWR_TIME\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";print "LINE=".__LINE__."\n";
}
}
$deploy_needed=$deploy=1;print "LINE=".__LINE__."\n";
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';print "LINE=".__LINE__."\n";
} else {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="DIFF_TIME $btime $dtime";print "LINE=".__LINE__."\n";
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(e) $file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(e) $file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=" DEPLOY $file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=
" DEPLOY(f) $key/$file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(f) $key/$file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=
" DEPLOY $key/$file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $key/$file - DIFF_TIME\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";print "LINE=".__LINE__."\n";
}
}
$deploy_needed=$deploy=1;print "LINE=".__LINE__."\n";
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';print "LINE=".__LINE__."\n";
}
} else {
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="SAME $btime $bsize";print "LINE=".__LINE__."\n";
if ($key eq '/') {
$debug_info.=
"SKIP FILE $file - SAME_SIZE_TIME_STAMP2\n";print "LINE=".__LINE__."\n";
} else {
$debug_info.=
"SKIP FILE $key/$file - SAME_SIZE_TIME_STAMP2\n";print "LINE=".__LINE__."\n";
}
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;print "LINE=".__LINE__."\n";
$skip=1;next;print "LINE=".__LINE__."\n";
}
} else {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]='NOT_ON_DEST';print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;print "LINE=".__LINE__."\n";
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(g) $file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(g) $file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=" DEPLOY $file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{$file}=$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=$file;print "LINE=".__LINE__."\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(h) $key/$file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY(h) $key/$file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
} else {
$deploy_info.=" DEPLOY $key/$file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
$debug_info.="DEPLOY $key/$file - NOT_ON_DEST\n";print "LINE=".__LINE__."\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";print "LINE=".__LINE__."\n";
}
}
$deploy_needed=$deploy=1;print "LINE=".__LINE__."\n";
}
$btime=~tr/ //;print "LINE=".__LINE__."\n";
if ($key ne '/') {
$timekey="$key/$file";print "LINE=".__LINE__."\n";
} else { $timekey=$file }
${$timehash}{$timekey}=[$byear,$btime];print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
}
if ($skip) {
if ($deploy) {
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_SOMEFILES_OF_CURDIR';print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[0]='SOME';print "LINE=".__LINE__."\n";
foreach my $key (@keys) {
${$baseFH->{_bhash}}{$key}[0]='SOME';print "LINE=".__LINE__."\n";
}
} else {
delete ${$destFH->{_dhash}}{$key}
if !keys %{${$destFH->{_dhash}}{$key}[1]};print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_NOFILES_OF_CURDIR';print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[0]='EXCLUDE'
if ${$baseFH->{_bhash}}{$key}[0] ne 'SOME'
&& ${$baseFH->{_bhash}}{$key}[0] ne 'NOT_ON_DEST';print "LINE=".__LINE__."\n";
}
} elsif ($deploy) {
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_SOMEFILES_OF_CURDIR';print "LINE=".__LINE__."\n";
} else {
delete ${$destFH->{_dhash}}{$key}
if !keys %{${$destFH->{_dhash}}{$key}[1]};print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_NOFILES_OF_CURDIR';print "LINE=".__LINE__."\n";
${$baseFH->{_bhash}}{$key}[0]='EXCLUDE'
if ${$baseFH->{_bhash}}{$key}[0] ne 'SOME'
&& ${$baseFH->{_bhash}}{$key}[0] ne 'NOT_ON_DEST'
&& !$deploy_empty_dir;print "LINE=".__LINE__."\n";
} $deploy_empty_dir=0;print "LINE=".__LINE__."\n";
} ${$baseFH->{_bhash}}{'/'}[0]='EXCLUDE' if !$deploy_needed;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','','',$@;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return '','','','',$die;print "LINE=".__LINE__."\n";
}
}
print $Net::FullAuto::FA_Core::MRLOG "KEYSBASEHASHTEST=",keys %{$baseFH->{_bhash}},"\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $baseFH, $destFH, $timehash, $deploy_info, $debug_info;print "LINE=".__LINE__."\n";
}
sub build_base_dest_hashes
{
#print "BBDH CALLER=",caller,"\n";print "LINE=".__LINE__."\n";
my $modifiers='';my $mod_dirs_flag='';print "LINE=".__LINE__."\n";
my $mod_files_flag='';my $s=0;print "LINE=".__LINE__."\n";
my $num_of_included=0;my $num_of_excluded=0;print "LINE=".__LINE__."\n";
my @modifiers=();print "LINE=".__LINE__."\n";
my $base_or_dest_folder=$_[0];print "LINE=".__LINE__."\n";
my $ms_share=$_[4];$ms_share||='';print "LINE=".__LINE__."\n";
my $ms_domain=$_[5];$ms_domain||='';print "LINE=".__LINE__."\n";
my $cygwin = (-1<index lc($_[6]),'cygwin') ? 1 : 0;print "LINE=".__LINE__."\n";
my $cmd_handle=$_[7];$cmd_handle||='';print "LINE=".__LINE__."\n";
my $base_dest=$_[8];print "LINE=".__LINE__."\n";
my $lsgnu=$_[9];print "LINE=".__LINE__."\n";
my $zipdir=$_[10]||'';print "LINE=".__LINE__."\n";
my $cache=$_[11]||'';print "LINE=".__LINE__."\n";
my $bd='';print "LINE=".__LINE__."\n";
$bd=($base_dest eq 'BASE')?'b':'d';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
my %navhash=();print "LINE=".__LINE__."\n";
eval {
if ($_[2]) { # If we have Directives
my @directives=@{$_[2]};my @delim=();print "LINE=".__LINE__."\n";
foreach my $directive (@directives) {
$s=0;$s=1 if $directive=~/^s/;print "LINE=".__LINE__."\n";
if ($s==1 || substr($directive,0,1) eq 'm') {
$delim[0]=substr($directive,1,1);print "LINE=".__LINE__."\n";
} 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];print "LINE=".__LINE__."\n";
my $modifiers=lc(substr($directive,$rindex+1));print "LINE=".__LINE__."\n";
my $regex=substr($directive,(index $directive,$delim[0])+1,
$rindex-1);print "LINE=".__LINE__."\n";
my $perl_mods='';print "LINE=".__LINE__."\n";
my $mods='';print "LINE=".__LINE__."\n";
if ($directive=~/^s/) {
$s=1;print "LINE=".__LINE__."\n";
$perl_mods.='g' if -1<index $modifiers,'g';print "LINE=".__LINE__."\n";
$perl_mods.='e' if -1<index $modifiers,'e';print "LINE=".__LINE__."\n";
} elsif (-1<index $modifiers,'e') { $mods.='e' }
$perl_mods.='i' if -1<index $modifiers,'i';print "LINE=".__LINE__."\n";
if (-1<index $modifiers,'d') {
if ($s) {
push @modifiers, [ qr/$regex/,$perl_mods,"s$mods",'d' ];print "LINE=".__LINE__."\n";
} elsif (-1<index $modifiers,'e') {
push @modifiers, [ qr/$regex/,$perl_mods,$mods,'d' ];print "LINE=".__LINE__."\n";
} else {
push @modifiers, [ qr/$regex/,$perl_mods,"${mods}i",'d' ];print "LINE=".__LINE__."\n";
} $mod_dirs_flag=1;print "LINE=".__LINE__."\n";
} else {
if ($s) {
push @modifiers, [ qr/$regex/,$perl_mods,"s$mods",'f' ];print "LINE=".__LINE__."\n";
} elsif (-1<index $modifiers,'e') {
push @modifiers, [ qr/$regex/,$perl_mods,$mods,'f' ];print "LINE=".__LINE__."\n";
} else {
push @modifiers, [ qr/$regex/,$perl_mods,"${mods}i",'f' ];print "LINE=".__LINE__."\n";
} $mod_files_flag=1;print "LINE=".__LINE__."\n";
}
}
sub regx_prog
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "regx_prog() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $ex=$_[0];my $type=$_[1];print "LINE=".__LINE__."\n";
my $sub = sub {
my $result=0;my $string='';$_[1]||='';print "LINE=".__LINE__."\n";
if ($type eq 'f' && $_[1] ne ''
&& -1<index ${$ex}[0],'/') {
if ($_[1] eq '/') {
$string=$_[0];print "LINE=".__LINE__."\n";
} else {
$_[1]=~s/\/+$//;print "LINE=".__LINE__."\n";
$string="$_[1]/$_[0]";print "LINE=".__LINE__."\n";
}
} 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;print "LINE=".__LINE__."\n";
} else {
$result=1 if $string=~m#${$ex}[0]#sg;print "LINE=".__LINE__."\n";
}
} else {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#si;print "LINE=".__LINE__."\n";
} else {
$result=1 if $string=~m#${$ex}[0]#s;print "LINE=".__LINE__."\n";
}
}
} 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;print "LINE=".__LINE__."\n";
} else {
$result=1 if $string=~m#${$ex}[0]#mg;print "LINE=".__LINE__."\n";
}
} else {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#mi;print "LINE=".__LINE__."\n";
} else {
$result=1 if $string=~m#${$ex}[0]#m;print "LINE=".__LINE__."\n";
}
}
} elsif (-1<index ${$ex}[1],'g') {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#gi;print "LINE=".__LINE__."\n";
} else {
$result=1 if $string=~m#${$ex}[0]#g;print "LINE=".__LINE__."\n";
}
} else {
$result=1 if $string=~m#${$ex}[0]#;print "LINE=".__LINE__."\n";
} return $result,${$ex}[2]||'';print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
$sub; # Save Pound Sign
}
}
my $len_dir='';my $archive_flag=0;print "LINE=".__LINE__."\n";
if ($zipdir) {
my $ln=substr(${$_[1]},0,(index ${$_[1]},"\n"));print "LINE=".__LINE__."\n";
$zipdir=~s/\/+$//;print "LINE=".__LINE__."\n";
$len_dir=length " xx-xx-xx 00:00 $zipdir";print "LINE=".__LINE__."\n";
} elsif (!$ms_share && !$ms_domain && !$cygwin) {
$len_dir=(length $base_or_dest_folder)+2;print "LINE=".__LINE__."\n";
} elsif ($base_or_dest_folder=~/$cmd_handle->{_cygdrive_regex}/) {
my $tmp_basedest=$base_or_dest_folder;print "LINE=".__LINE__."\n";
$tmp_basedest=~s/$cmd_handle->{_cygdrive_regex}//;print "LINE=".__LINE__."\n";
substr($tmp_basedest,0,1)=unpack('a1',$tmp_basedest).':';print "LINE=".__LINE__."\n";
my $d=${$_[1]};print "LINE=".__LINE__."\n";
my $i=index $d,'Directory of';print "LINE=".__LINE__."\n";
$i+=12;print "LINE=".__LINE__."\n";
$d=unpack("x$i a5",$d);print "LINE=".__LINE__."\n";
$d=~s/^(\s+).*$/$1/;print "LINE=".__LINE__."\n";
$len_dir=length ".Directory.of${d}$tmp_basedest/";print "LINE=".__LINE__."\n";
} elsif ($ms_share) {
my $d=${$_[1]};print "LINE=".__LINE__."\n";
my $i=index $d,'Directory of';print "LINE=".__LINE__."\n";
$i+=12;print "LINE=".__LINE__."\n";
$d=unpack("x$i a5",$d);print "LINE=".__LINE__."\n";
$d=~s/^(\s+).*$/$1/;print "LINE=".__LINE__."\n";
$len_dir=length
".Directory.of$d$_[3].$_[4].$base_or_dest_folder";print "LINE=".__LINE__."\n";
$len_dir=$len_dir-2
if substr($base_or_dest_folder,-2) eq '/.';print "LINE=".__LINE__."\n";
} elsif ($base_or_dest_folder=~/^\w:/) {
my $d=${$_[1]};print "LINE=".__LINE__."\n";
my $i=index $d,'Directory of';print "LINE=".__LINE__."\n";
$i+=12;print "LINE=".__LINE__."\n";
$d=unpack("x$i a5",$d);print "LINE=".__LINE__."\n";
$d=~s/^(\s+).*$/$1/;print "LINE=".__LINE__."\n";
$len_dir=length ".Directory.of${d}$base_or_dest_folder/";print "LINE=".__LINE__."\n";
} elsif ($cygwin) {
my $tmp_bd=unpack('x1 a*',$base_or_dest_folder);print "LINE=".__LINE__."\n";
$tmp_bd=substr($tmp_bd,(index $tmp_bd,'/'));print "LINE=".__LINE__."\n";
my $d=${$_[1]};print "LINE=".__LINE__."\n";
my $i=index $d,'Directory of';print "LINE=".__LINE__."\n";
$i+=12;print "LINE=".__LINE__."\n";
$d=unpack("x$i a5",$d);print "LINE=".__LINE__."\n";
$d=~s/^(\s+).*$/$1/;print "LINE=".__LINE__."\n";
$len_dir=length ".Directory.of${d}$tmp_bd/";print "LINE=".__LINE__."\n";
} else {
my $d=${$_[1]};print "LINE=".__LINE__."\n";
my $i=index $d,'Directory of';print "LINE=".__LINE__."\n";
$i+=12;print "LINE=".__LINE__."\n";
$d=unpack("x$i a5",$d);print "LINE=".__LINE__."\n";
$d=~s/^(\s+).*$/$1/;print "LINE=".__LINE__."\n";
$len_dir=length ".Directory.of${d}$base_or_dest_folder/";print "LINE=".__LINE__."\n";
}
my $time='';my $files_flag='';my $mn=0;my $dy=0;print "LINE=".__LINE__."\n";
my $yr=0;my $hr=0;my $mt=0;my $pm='';my $size='';print "LINE=".__LINE__."\n";
my $file='';my $fchar='';my $u='';my $tm='';print "LINE=".__LINE__."\n";
my $g='';my $o='';my $topkey='';my $lchar_flag='';print "LINE=".__LINE__."\n";
my $excluded_parent_dir=0;my $included_parent_dir=0;print "LINE=".__LINE__."\n";
my $fileyr=0;my $bit=0;my $chmod='';print "LINE=".__LINE__."\n";
my $cur_dir_excluded=0;my $file_count=0;my $dofiles=0;print "LINE=".__LINE__."\n";
my @keys=();my $addbytes=0;my $nt5=0;print "LINE=".__LINE__."\n";
my $prevkey='';my $savekey='';my $savetotal=0;print "LINE=".__LINE__."\n";
${$cmd_handle->{"_${bd}hash"}}{'/'}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
my $key='/';my $bytesize=0;my $total=0;print "LINE=".__LINE__."\n";
#$xxxnext=0;print "LINE=".__LINE__."\n";
#if (!$cygwin) {
#open(BK,">brianout.txt");print "LINE=".__LINE__."\n";
#print BK ${$_[1]};print "LINE=".__LINE__."\n";
#CORE::close BK;print "LINE=".__LINE__."\n";
#}
my @sublines=();my $lenflag=0;my $bs=0;my $bl=0;print "LINE=".__LINE__."\n";
#print "OUTPUT==>${$_[1]}<==\n";print "LINE=".__LINE__."\n";
FL: foreach my $line (split /^/, ${$_[1]}) {
my $parse=1;my $trak=0;print "LINE=".__LINE__."\n";
if ($savekey) {
#print "SAVEKEY=$savekey and LINE=$line<==\n";<STDIN>;print "LINE=".__LINE__."\n";
$key=$savekey;print "LINE=".__LINE__."\n";
$total=$savetotal;print "LINE=".__LINE__."\n";
$dofiles=0;print "LINE=".__LINE__."\n";
$savekey='';print "LINE=".__LINE__."\n";
$savetotal=0;print "LINE=".__LINE__."\n";
}
next if $line=~/^\s*$/;print "LINE=".__LINE__."\n";
WH: while ($parse || ($line=pop @sublines)) {
$parse=0;print "LINE=".__LINE__."\n";
$mn=0;$dy=0;$yr=0;$hr=0;print "LINE=".__LINE__."\n";
$mt='';$pm='';$size='';$file='';print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else {
$bs=24;$bl=39;print "LINE=".__LINE__."\n";
}
$lenflag=1;print "LINE=".__LINE__."\n";
} else { next }
}
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
if ($bl<length $line) {
if ($bs==23) {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
$line=~s/\s+PM/PM/;print "LINE=".__LINE__."\n";
$line=~s/\s+AM/AM/;print "LINE=".__LINE__."\n";
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @23 a14 @38 a*'
,$line);print "LINE=".__LINE__."\n";
$nt5=1;print "LINE=".__LINE__."\n";
$fileyr=$curcen.$yr;print "LINE=".__LINE__."\n";
$size=~s/^\s*//;print "LINE=".__LINE__."\n";
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};print "LINE=".__LINE__."\n";
} else {
$line=~s/\s+PM/PM/;print "LINE=".__LINE__."\n";
$line=~s/\s+AM/AM/;print "LINE=".__LINE__."\n";
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @23 a14 @38 a*'
,$line);print "LINE=".__LINE__."\n";
$fileyr=$curcen.$yr;print "LINE=".__LINE__."\n";
$size=~s/^\s*//;print "LINE=".__LINE__."\n";
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};print "LINE=".__LINE__."\n";
}
} else {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
$line=~s/\s+PM/PM/;print "LINE=".__LINE__."\n";
$line=~s/\s+AM/AM/;print "LINE=".__LINE__."\n";
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,$line);print "LINE=".__LINE__."\n";
$nt5=1;print "LINE=".__LINE__."\n";
$fileyr=$curcen.$yr;print "LINE=".__LINE__."\n";
$size=~s/^\s*//;print "LINE=".__LINE__."\n";
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};print "LINE=".__LINE__."\n";
} else {
$line=~s/\s+PM/PM/;print "LINE=".__LINE__."\n";
$line=~s/\s+AM/AM/;print "LINE=".__LINE__."\n";
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,$line);print "LINE=".__LINE__."\n";
$fileyr=$curcen.$yr;print "LINE=".__LINE__."\n";
$size=~s/^\s*//;print "LINE=".__LINE__."\n";
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};print "LINE=".__LINE__."\n";
}
}
} else { $mn=unpack('a2',$line) }
#if ($key=~/bcbsa_assets/ and ($file=~/Print_Pre/)) {
#print "MSWin_LINE=$line and KEY=$key and HR=$hr and MN=$mn and file=$file and MT=$mt and SIZE=$size\n";sleep 2;print "LINE=".__LINE__."\n";
#}
next if $mn eq '' || $mn eq ' '
|| unpack('a1',$size) eq '<';print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
}
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";print "LINE=".__LINE__."\n";
#}
$fchar='';$u='';$g='';$o='';$chmod='';print "LINE=".__LINE__."\n";
chomp($line);print "LINE=".__LINE__."\n";
next if $line eq '';print "LINE=".__LINE__."\n";
my $lchar=substr($line,-1);print "LINE=".__LINE__."\n";
if ($lchar eq '*' || $lchar eq '/' || $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;print "LINE=".__LINE__."\n";
$lchar_flag=1;print "LINE=".__LINE__."\n";
} chop $line;print "LINE=".__LINE__."\n";
}
my $endofline=substr($line,-2);print "LINE=".__LINE__."\n";
if ($line=~s/^\s*([0-9]+)\s//) {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "LS OUTPUT LINE=$line<==\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"LS OUTPUT LINE=$line<==\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"LS OUTPUT LINE=$line<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$bytesize=$1;print "LINE=".__LINE__."\n";
unless ($zipdir) {
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);print "LINE=".__LINE__."\n";
} elsif ($bytesize==0) {
$fchar='/';print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "ADDING BYTES TO TOTAL ==>$bytesize<==\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"ADDING BYTES TO TOTAL ==>$bytesize<==\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
$addbytes+=$bytesize;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "TOTAL BYTESIZE==>$addbytes<==\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"TOTAL BYTESIZE==>$addbytes<==\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"TOTAL BYTESIZE==>$addbytes<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$dofiles=1;print "LINE=".__LINE__."\n";
if ($endofline eq '..' || $endofline eq ' .') { next }
} else {
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);print "LINE=".__LINE__."\n";
if ($fchar eq 't') {
#print "TOTAL=$total and ADDBYTES=$addbytes and PREVKEY=$prevkey\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
if ($dofiles && $total!=$addbytes) {
#print "WE HAVE A PROBLEM HOUSTON and KEY=$prevkey<--\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
@sublines=();print "LINE=".__LINE__."\n";
$savekey=$key;print "LINE=".__LINE__."\n";
$savetotal=unpack('x6 a*',$line);print "LINE=".__LINE__."\n";
$key=$prevkey;print "LINE=".__LINE__."\n";
die 'redo ls' if $key eq '/';print "LINE=".__LINE__."\n";
$addbytes=0;print "LINE=".__LINE__."\n";
my $ls_path='';print "LINE=".__LINE__."\n";
if ($cmd_handle->{_hostlabel}->[0] eq
"__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};print "LINE=".__LINE__."\n";
$ls_path.='/' if $ls_path!~/\/$/;print "LINE=".__LINE__."\n";
}
while (1) {
#print "LOOPING IN WHILE TO CORRECT LS -> KEY=$key\n";print "LINE=".__LINE__."\n";
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls --version") unless $lsgnu;print "LINE=".__LINE__."\n";
if ($lsgnu || (-1<index $stdout,'GNU')) {
$lsgnu=1;print "LINE=".__LINE__."\n";
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls -lRs --block-size=1 \'$key\'");print "LINE=".__LINE__."\n";
} else {
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls -lRs \'$key\'");print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
my $add_bytes=0;print "LINE=".__LINE__."\n";
#print "LS LOOPING STDOUT=$stdout\n";print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $stdout) {
chomp($line);print "LINE=".__LINE__."\n";
next if $line eq '';print "LINE=".__LINE__."\n";
if ($line=~/^total /) {
$total+=unpack('x6 a*',$line);print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
my $lchar=substr($line,-1);print "LINE=".__LINE__."\n";
if ($lchar eq '*' || $lchar eq '/'
|| $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;print "LINE=".__LINE__."\n";
$lchar_flag=1;print "LINE=".__LINE__."\n";
} chop $line;print "LINE=".__LINE__."\n";
}
my $endofline=substr($line,-2);print "LINE=".__LINE__."\n";
if ($line=~s/^\s*([0-9]+)\s//) {
my $bytesize=$1;print "LINE=".__LINE__."\n";
next if $bytesize!~/\d+/;print "LINE=".__LINE__."\n";
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);print "LINE=".__LINE__."\n";
$add_bytes+=$bytesize;print "LINE=".__LINE__."\n";
if ($endofline eq '..'
|| $endofline eq ' .') { next }
push @sublines, $line;print "LINE=".__LINE__."\n";
}
} last if $add_bytes==$total;print "LINE=".__LINE__."\n";
$total=0;print "LINE=".__LINE__."\n";
} next WH;print "LINE=".__LINE__."\n";
} else {
$total=unpack('x6 a*',$line);print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "TOTAL BYTES FINAL TALLY==>$total<==\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"TOTAL BYTES FINAL TALLY==>$total<==\n"])
if $cache;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
if (-1<index $total,'stdout:') {
$total=~s/^(\d+)(stdout:.*)$/$1/;print "LINE=".__LINE__."\n";
push @sublines, $2;print "LINE=".__LINE__."\n";
}
$addbytes=0;print "LINE=".__LINE__."\n";
}
}
}
my $per=lc("$u$g$0");print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} else {
$bit=6;print "LINE=".__LINE__."\n";
}
} else {
if (-1<index lc($o),'t') {
$bit=5;print "LINE=".__LINE__."\n";
} else {
$bit=4;print "LINE=".__LINE__."\n";
}
}
}
if ($bit<6 && -1<index lc($g),'s') {
if (-1<index lc($o),'t') {
$bit=3;print "LINE=".__LINE__."\n";
} else {
$bit=2;print "LINE=".__LINE__."\n";
}
} elsif ($bit<2 && -1<index lc($o),'t') {
$bit=1;print "LINE=".__LINE__."\n";
} else {
$bit=0;print "LINE=".__LINE__."\n";
}
$chmod=$bit.$Net::FullAuto::FA_Core::perms{$u};print "LINE=".__LINE__."\n";
$chmod.=$Net::FullAuto::FA_Core::perms{$g}.
$Net::FullAuto::FA_Core::perms{$o};print "LINE=".__LINE__."\n";
}
}
#if ($key=~/careers/) {
#if ($excluded_parent_dir) {
# print "KEY=$key and MODS=@modifiers and EXCLUDE_PARENT_DIR=$excluded_parent_dir\n";print "LINE=".__LINE__."\n";
#} elsif ($included_parent_dir) {
# print "KEY=$key and MODS=@modifiers and INCLUDE_PARENT_DIR=$included_parent_dir\n";print "LINE=".__LINE__."\n";
#}
#print "CYGWINNNNN=$cygwin and FCHAR=$fchar and MN=$mn and SIZE=$size and KEY=$key\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
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>;print "LINE=".__LINE__."\n";
#}
if ($mod_dirs_flag) {
foreach my $modif (@modifiers) {
@keys=();print "LINE=".__LINE__."\n";
next if ${$modif}[3] eq 'f';print "LINE=".__LINE__."\n";
if (${$modif}[3] eq 'd') {
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;print "LINE=".__LINE__."\n";
$key=unpack("x$len_dir a*",$line);print "LINE=".__LINE__."\n";
if ($ms_share || $ms_domain || $cygwin) {
$key=~tr/\\/\//;print "LINE=".__LINE__."\n";
}
$file_count=0;print "LINE=".__LINE__."\n";
$cur_dir_excluded=0;print "LINE=".__LINE__."\n";
}
if ($key ne '/') {
if (-1<index $key,'/') {
my $chkkey=$key;print "LINE=".__LINE__."\n";
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;print "LINE=".__LINE__."\n";
last if -1==index $chkkey,'/';print "LINE=".__LINE__."\n";
}
} else { unshift @keys, $key }
} unshift @keys, '/';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::d_sub=regx_prog($modif,'d');print "LINE=".__LINE__."\n";
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
#if ($key eq '/') {
#print "KEY=$key and KEYSNOW33=@keys\n";print "LINE=".__LINE__."\n";
#}
($return,$returned_modif)=&$d_sub($key);print "LINE=".__LINE__."\n";
#if ($key eq '/') { # && $file=~/index/) {
#print "KEY=$key RETURN=$return and RETURNED_MODIF=$returned_modif\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
if ($return) {
if (-1<index $returned_modif,'e') {
${$cmd_handle->{"_${bd}hash"}}{$key}
=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
#print "BASE_DEST=$base_dest and EXCLUDEDKEY=$key\n";<STDIN>;print "LINE=".__LINE__."\n";
if ($base_dest eq 'BASE') {
$Net::FullAuto::FA_Core::base_excluded_dirs{$key}='-';print "LINE=".__LINE__."\n";
}
$excluded_parent_dir=$key;print "LINE=".__LINE__."\n";
$included_parent_dir='';print "LINE=".__LINE__."\n";
} else {
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
foreach my $key (@keys) {
if (${$cmd_handle->{"_${bd}hash"}}{$key}[0]
eq 'EXCLUDE') {
#print "HERE I AMMM777 AND KEY=$key\n";<STDIN>;print "LINE=".__LINE__."\n";
${$cmd_handle->{"_${bd}hash"}}{$key}[0]
='SOME';print "LINE=".__LINE__."\n";
}
}
$excluded_parent_dir='';print "LINE=".__LINE__."\n";
$included_parent_dir=$key;print "LINE=".__LINE__."\n";
}
} 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>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
$included_parent_dir='';print "LINE=".__LINE__."\n";
} 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>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
$excluded_parent_dir='';print "LINE=".__LINE__."\n";
} elsif ((-1<index ${$modif}[2],'i') &&
(-1==index ${$modif}[2],'e')) {
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
$excluded_parent_dir='';print "LINE=".__LINE__."\n";
$included_parent_dir='';print "LINE=".__LINE__."\n";
} else {
#if ($key=~/bmicalculator/) {
#print "OUTHASH_ELSE_KEY=$key\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
$excluded_parent_dir='';print "LINE=".__LINE__."\n";
$included_parent_dir='';print "LINE=".__LINE__."\n";
}
} else {
#if ($key=~/bmicalculator/) {
#print "YEERRRRR=$key\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;print "LINE=".__LINE__."\n";
$key=unpack("x$len_dir a*",$line);print "LINE=".__LINE__."\n";
#print "KEYYYYYYYYYYYYYY=$key and LINE=$line and LENDIR=$len_dir\n";sleep 2;print "LINE=".__LINE__."\n";
#print "KEYHERERERERER2222222 and LINE=$line\n" if $key eq 'member/my_health/calculators/bmicalculator/images';print "LINE=".__LINE__."\n";
#<STDIN> if $key eq 'member/my_health/calculators/bmicalculator/images';print "LINE=".__LINE__."\n";
if ($ms_share || $ms_domain || $cygwin) {
$key=~tr/\\/\//;print "LINE=".__LINE__."\n";
}
$file_count=0;print "LINE=".__LINE__."\n";
$cur_dir_excluded=0;print "LINE=".__LINE__."\n";
}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
}
}
} 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>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[0]='SOME';print "LINE=".__LINE__."\n";
}
#print "WHAT IS THE LEN_DIR=$len_dir and LINE=$line<==\n";print "LINE=".__LINE__."\n";
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;print "LINE=".__LINE__."\n";
$key=unpack("x$len_dir a*",$line);print "LINE=".__LINE__."\n";
#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';print "LINE=".__LINE__."\n";
#<STDIN> if $key eq 'member/my_health/calculators/bmicalculator/images';print "LINE=".__LINE__."\n";
if ($ms_share || $ms_domain || $cygwin) {
$key=~tr/\\/\//;print "LINE=".__LINE__."\n";
}
$file_count=0;print "LINE=".__LINE__."\n";
$cur_dir_excluded=0;print "LINE=".__LINE__."\n";
}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];print "LINE=".__LINE__."\n";
}
} elsif ((!$cygwin && $fchar eq '-' || $zipdir) ||
($cygwin && $mn ne ' D' && unpack('a5',$size) ne '<DIR>')) {
$file_count++;print "LINE=".__LINE__."\n";
#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>;print "LINE=".__LINE__."\n";
#}
if (!$cygwin && ($fchar eq '-' || $fchar eq 'l')) {
my $up=unpack('x10 a*',$line);print "LINE=".__LINE__."\n";
$up=~s/^[.+ ]?\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)$/$1/;print "LINE=".__LINE__."\n";
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;print "LINE=".__LINE__."\n";
my $yr='';print "LINE=".__LINE__."\n";
if ($mn=~/(\d\d\d\d)-(\d\d)-(\d\d)/) {
$file=$tm;print "LINE=".__LINE__."\n";
$tm=$dy;print "LINE=".__LINE__."\n";
$yr=$1;$mn=$2;$dy=$3;print "LINE=".__LINE__."\n";
$dy='0'.$dy if $dy=~/^\d$/;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
if ((-1==index $up,' Jan ') && (-1==index $up,' Feb ') &&
(-1==index $up,' Mar ') && (-1==index $up,' Apr ') &&
(-1==index $up,' May ') && (-1==index $up,' Jun ') &&
(-1==index $up,' Jul ') && (-1==index $up,' Aug ') &&
(-1==index $up,' Sep ') && (-1==index $up,' Oct ') &&
(-1==index $up,' Nov ') && (-1==index $up,' Dec ')) {
($stdout,$stderr)=$cmd_handle->cmd(
"ls -l \"$file\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
my $lchar=substr($stdout,-1);print "LINE=".__LINE__."\n";
if ($lchar eq '*' || $lchar eq '/'
|| $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;print "LINE=".__LINE__."\n";
$lchar_flag=1;print "LINE=".__LINE__."\n";
} chop $line;print "LINE=".__LINE__."\n";
}
push @sublines, $stdout;print "LINE=".__LINE__."\n";
next WH;print "LINE=".__LINE__."\n";
} else {
substr($up,-(length $file))='';print "LINE=".__LINE__."\n";
$up=~/\s+(\d+)\s+(\w\w\w)\s+(\d+)\s+(\d+:?\d+).*$/;print "LINE=".__LINE__."\n";
$size=$1;$mn=$2;$dy=$3;$tm=$4;print "LINE=".__LINE__."\n";
$dy='0'.$dy if $dy=~/^\d$/;print "LINE=".__LINE__."\n";
}
}
$mn=$Net::FullAuto::FA_Core::month{$mn} if length $mn==3;print "LINE=".__LINE__."\n";
$fileyr=0;$hr=0;$mt=0;print "LINE=".__LINE__."\n";
if (length $tm==4) {
$fileyr=$tm;$hr='--';$mt='--';print "LINE=".__LINE__."\n";
} elsif ($yr) {
($hr,$mt)=unpack('a2 @3 a2',$tm);print "LINE=".__LINE__."\n";
$fileyr=$yr;print "LINE=".__LINE__."\n";
} else {
($hr,$mt)=unpack('a2 @3 a2',$tm);print "LINE=".__LINE__."\n";
$yr=unpack('x1 a2',"$Net::FullAuto::FA_Core::thisyear");print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$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);print "LINE=".__LINE__."\n";
if (time()<$filetime) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
}
}
}
$file=s/ -> .*$// if -1<index $file,' -> ';print "LINE=".__LINE__."\n";
} elsif ($zipdir) {
$line=~s/^\s//;print "LINE=".__LINE__."\n";
my $fullfile='';print "LINE=".__LINE__."\n";
($dy,$tm,$fullfile)=split / +/, $line;print "LINE=".__LINE__."\n";
($mn,$dy,$yr)=split '-', $dy;print "LINE=".__LINE__."\n";
($hr,$mt)=split ':', $tm;print "LINE=".__LINE__."\n";
$file=substr($fullfile,(rindex $fullfile,'/')+1);print "LINE=".__LINE__."\n";
if ($fullfile ne $zipdir.'/'.$key.'/'.$file) {
my @kdirs=($key);print "LINE=".__LINE__."\n";
if (-1<index $key,'/') {
@kdirs=split '/',$key;print "LINE=".__LINE__."\n";
}
if ($#kdirs==0) {
$key='/';print "LINE=".__LINE__."\n";
} else {
while (pop @kdirs) {
my $di=join '/', @kdirs;print "LINE=".__LINE__."\n";
if ($fullfile eq $zipdir.'/'.$di.'/'.$file) {
$key=$di;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
}
}
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
$size=$bytesize;print "LINE=".__LINE__."\n";
}
#if ($key eq '/') {
#print "CYGWINNNNN\n" if $cygwin;print "LINE=".__LINE__."\n";
#print "WITH CAREER AND FILE DIR=$key and FILE=$file and MODFILEFLAG=$mod_files_flag\n";#<STDIN>;print "LINE=".__LINE__."\n";
#}
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";print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];print "LINE=".__LINE__."\n";
$num_of_excluded++;print "LINE=".__LINE__."\n";
} elsif ($mod_files_flag) {
foreach my $modif (@modifiers) {
if (${$modif}[3] eq 'f') {
$Net::FullAuto::FA_Core::f_sub=regx_prog($modif,'f');print "LINE=".__LINE__."\n";
my $return=0;my $returned_modif='';print "LINE=".__LINE__."\n";
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key);print "LINE=".__LINE__."\n";
my $fileyr=0;print "LINE=".__LINE__."\n";
#if ($key eq '/') {
# print "FILE=$file and RETURN=$return and MODIF=$returned_modif\n";print "LINE=".__LINE__."\n";
# <STDIN>;print "LINE=".__LINE__."\n";
#}
if ($return || (-1<index $returned_modif,'e')) {
if ($return && (-1<index $returned_modif,'e')) {
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::base_excluded_files{$key}
{$file}='-';print "LINE=".__LINE__."\n";
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_SOMEFILES_OF_CURDIR') {
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
='DEPLOY_NOFILES_OF_CURDIR';print "LINE=".__LINE__."\n";
}
$num_of_excluded++;print "LINE=".__LINE__."\n";
$cur_dir_excluded++;print "LINE=".__LINE__."\n";
} else {
if (!$ms_share && !$ms_domain && !$cygwin) {
my $up=unpack('x10 a*',$line);print "LINE=".__LINE__."\n";
my $rx=qr/\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)/;print "LINE=".__LINE__."\n";
$up=~s/^[.+ ]?$rx$/$1/;print "LINE=".__LINE__."\n";
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;print "LINE=".__LINE__."\n";
$mn=$Net::FullAuto::FA_Core::month{$mn}
if length $mn==3;print "LINE=".__LINE__."\n";
$fileyr=0;my $hr=0;my $mt='';print "LINE=".__LINE__."\n";
if (length $tm==4) {
$fileyr=$tm;$hr='--';$mt='--';print "LINE=".__LINE__."\n";
} else {
($hr,$mt)=unpack('a2 @3 a2',$tm);print "LINE=".__LINE__."\n";
my $yr=unpack('x1 a2',
$Net::FullAuto::FA_Core::thisyear);print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::thismonth <
$mn-1) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$fileyr=
$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::thismonth
==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);print "LINE=".__LINE__."\n";
if (time()<$filetime) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$fileyr=
$Net::FullAuto::FA_Core::curcen
.$yr;print "LINE=".__LINE__."\n";
}
}
}
$file=~s/\s*$//g;print "LINE=".__LINE__."\n";
next if !$file;print "LINE=".__LINE__."\n";
} $chmod=" $chmod" if $chmod;print "LINE=".__LINE__."\n";
my $dt=(3==length $mn)?$Net::FullAuto::FA_Core::month{$mn}:$mn;print "LINE=".__LINE__."\n";
#if ($file eq 'Print_Preview.gif') {
#print "GOOOOOOODDDDDFILE===$file and KEY=$key and HR=$hr\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$dt $dy $hr $mt $fileyr $size$chmod" ];print "LINE=".__LINE__."\n";
#if ($key eq '/') {
#print "WE JUST DID OUTHASH and KEY=$key and $#{[keys %{$cmd_handle->{"_${bd}hash"}}]}\n";print "LINE=".__LINE__."\n";
#}
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_NOFILES_OF_CURDIR') {
${$cmd_handle->{"_${bd}hash"}}{$key}[2]=
'DEPLOY_SOMEFILES_OF_CURDIR';print "LINE=".__LINE__."\n";
}
$num_of_included++;print "LINE=".__LINE__."\n";
}
} else {
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];print "LINE=".__LINE__."\n";
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>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
='DEPLOY_NOFILES_OF_CURDIR'
}
}
$num_of_excluded++;print "LINE=".__LINE__."\n";
}
}
}
} elsif ($hr=~/^\d\d$|^--$/) {
$chmod=" $chmod" if $chmod;print "LINE=".__LINE__."\n";
#print "ALL GOING==>$mn $dy $hr $mt $fileyr $size$chmod<== and FILE=$file and FILEYR=$fileyr<--\n";print "LINE=".__LINE__."\n";
#if ($file eq 'Print_Preview.gif') {
#print "GOOOOOOODDDDDFILE222===$file and KEY=$key and STRING=$mn $dy $hr $mt $fileyr $size$chmod\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$mn $dy $hr $mt $fileyr $size$chmod" ];print "LINE=".__LINE__."\n";
$num_of_included++;print "LINE=".__LINE__."\n";
} else {
my $fileyr=0;print "LINE=".__LINE__."\n";
if (!$cygwin) {
if ($zipdir) {
$line=~s/^\s//;print "LINE=".__LINE__."\n";
($dy,$tm,$file)=split / +/, $line;print "LINE=".__LINE__."\n";
($mn,$dy,$yr)=split '-', $dy;print "LINE=".__LINE__."\n";
($hr,$mt)=split ':', $tm;print "LINE=".__LINE__."\n";
$file=substr($file,(rindex $file,'/')+1);print "LINE=".__LINE__."\n";
} else {
my $up=unpack('x10 a*',"$line");print "LINE=".__LINE__."\n";
$up=~s/^[.+ ]?\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)$/$1/;print "LINE=".__LINE__."\n";
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;print "LINE=".__LINE__."\n";
my $yr='';$fileyr='';print "LINE=".__LINE__."\n";
if ($mn=~/(\d\d\d\d)-(\d\d)-(\d\d)/) {
$fileyr=$1;print "LINE=".__LINE__."\n";
$file=$tm;print "LINE=".__LINE__."\n";
$tm=$dy;print "LINE=".__LINE__."\n";
$mn=$2;$dy=$3;print "LINE=".__LINE__."\n";
}
}
$mn=$Net::FullAuto::FA_Core::month{$mn}
if length $mn==3;print "LINE=".__LINE__."\n";
my ($hr,$mt)='';print "LINE=".__LINE__."\n";
if (length $tm==4) {
$fileyr=$tm;$hr='--';$mt='--';print "LINE=".__LINE__."\n";
} elsif (!$fileyr) {
($hr,$mt)=unpack('a2 @3 a2',$tm);print "LINE=".__LINE__."\n";
$yr=unpack('x1 a2',$Net::FullAuto::FA_Core::thisyear);print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);print "LINE=".__LINE__."\n";
if (time()<$filetime) {
--$yr;print "LINE=".__LINE__."\n";
$yr="0$yr" if 1==length $yr;print "LINE=".__LINE__."\n";
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;print "LINE=".__LINE__."\n";
}
}
}
$file=~s/\s*$//g;print "LINE=".__LINE__."\n";
$file=s/ -> .*$// if -1<index $file,' -> ';print "LINE=".__LINE__."\n";
} $chmod=" $chmod" if $chmod;print "LINE=".__LINE__."\n";
my $dt=(3==length $mn)?$Net::FullAuto::FA_Core::month{$mn}:$mn;print "LINE=".__LINE__."\n";
#if ($file eq 'Print_Preview.gif') {
#print "GOOOOOOODDDDDFILE222===$file and KEY=$key and HR=$hr\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$mn $dy $hr $mt $fileyr $size$chmod" ];print "LINE=".__LINE__."\n";
#if ($key=~/pdf|common|stylesheet|header/ && $file=~/index/ && !$cygwin) {
#print "JUST UPDATED OUTHASH=",@{${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}},"\n";<STDIN>;print "LINE=".__LINE__."\n";
#}
$num_of_included++;print "LINE=".__LINE__."\n";
}
}
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
#print "DO WE HAVE AN ERROR AND WHAT IS IT=$@\n";<STDIN>;print "LINE=".__LINE__."\n";
return '','redo ls' if unpack('a7',$@) eq 'redo ls';print "LINE=".__LINE__."\n";
if (unpack('a10',$@) eq 'The System') {
return '',$@;print "LINE=".__LINE__."\n";
} else {
my $hostlabel='localhost';print "LINE=".__LINE__."\n";
if ($cmd_handle->{_hostlabel}->[0] ne "__Master_${$}__") {
$hostlabel=$cmd_handle->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return '', $die;print "LINE=".__LINE__."\n";
}
} ${$cmd_handle->{"_${bd}hash"}}{"___%EXCluD%E--NUMOFFILES"}=$num_of_included;print "LINE=".__LINE__."\n";
${$cmd_handle->{"_${bd}hash"}}{"___%EXCluD%E--NUMOFBASEFILES"}
=$num_of_included+$num_of_excluded;print "LINE=".__LINE__."\n";
return '','';print "LINE=".__LINE__."\n";
}
package Rem_Command;print "LINE=".__LINE__."\n";
# Handle INT SIGNAL interruption
# local $SIG{ INT } = sub{ print "I AM HERE" };print "LINE=".__LINE__."\n";
sub new {
print "Rem_Command::new CALLER=",caller,"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
our $timeout=$Net::FullAuto::FA_Core::timeout;print "LINE=".__LINE__."\n";
our $test=$Net::FullAuto::FA_Core::test;print "LINE=".__LINE__."\n";
my $self = { };print "LINE=".__LINE__."\n";
my $class=ref $_[0]||$_[0];print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $new_master=$_[2]||'';print "LINE=".__LINE__."\n";
my $_connect=$_[3]||'';print "LINE=".__LINE__."\n";
my $cache='';print "LINE=".__LINE__."\n";
my $override_login_id='';print "LINE=".__LINE__."\n";
if (defined $_[4]) {
if (-1<index $_[4],'Cache::FileCache') {
$cache=$_[4];print "LINE=".__LINE__."\n";
} elsif ((-1<index $_[4],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[4]->chi_root_class)) {
$cache=$_[4];print "LINE=".__LINE__."\n";
} else {
$override_login_id=$_[4];print "LINE=".__LINE__."\n";
}
}
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);print "LINE=".__LINE__."\n";
my $chk_id='';print "LINE=".__LINE__."\n";
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='';print "LINE=".__LINE__."\n";
my $ftm_type='';my $stderr='';my $cmd_pid='';my $shell='';print "LINE=".__LINE__."\n";
my $shell_pid=0;my $cygdrive='';my $smb='';print "LINE=".__LINE__."\n";
($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,$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
$stderr=~s/(at .*)$/\n\n $1/s;print "LINE=".__LINE__."\n";
my $die="\n FATAL ERROR! - $stderr";print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
return $cmd_handle,$die if wantarray;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
if ($smb) {
$self->{_hostlabel}=[ $hostlabel,
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0] ];print "LINE=".__LINE__."\n";
$self->{_smb}=1;print "LINE=".__LINE__."\n";
} else {
$self->{_hostlabel}=[ $hostlabel,'' ];print "LINE=".__LINE__."\n";
}
$self->{_cmd_handle}=$cmd_handle;print "LINE=".__LINE__."\n";
$self->{_cmd_type}=$cmd_type;print "LINE=".__LINE__."\n";
$self->{_connect}=$_connect;print "LINE=".__LINE__."\n";
$self->{_ftm_type}=$ftm_type;print "LINE=".__LINE__."\n";
$self->{_work_dirs}=$work_dirs;print "LINE=".__LINE__."\n";
$self->{_ip}=$ip;print "LINE=".__LINE__."\n";
$self->{_uname}=$uname;print "LINE=".__LINE__."\n";
$self->{_luname}=$^O;print "LINE=".__LINE__."\n";
$self->{_cmd_pid}=$cmd_pid;print "LINE=".__LINE__."\n";
$self->{_sh_pid}=$shell_pid;print "LINE=".__LINE__."\n";
$self->{_shell}=$shell;print "LINE=".__LINE__."\n";
if ($cygdrive) {
$self->{_cygdrive}=$cygdrive;print "LINE=".__LINE__."\n";
$self->{_cygdrive_regex}=qr/^$cygdrive\//;print "LINE=".__LINE__."\n";
}
bless($self,$class);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$chk_id"}=$self;print "LINE=".__LINE__."\n";
return $self,''
}
sub handle_error
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "Rem_Command::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
return &Net::FullAuto::FA_Core::handle_error(@_);print "LINE=".__LINE__."\n";
}
sub close
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "Rem_Command::close() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
if (defined fileno $self->{_cmd_handle}) {
my $gone=1;my $was_a_local=0;print "LINE=".__LINE__."\n";
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::gbp->('printf').
"printf $funkyprompt");print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
last if $line=~/logout|221\sGoodbye/sx;print "LINE=".__LINE__."\n";
if ($line=~/_funkyPrompt_$/s) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print("exit");print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
$gone=0;last CM;print "LINE=".__LINE__."\n";
} elsif (-1<index $line,
'Connection to localhost closed') {
$was_a_local=1;print "LINE=".__LINE__."\n";
last CM;print "LINE=".__LINE__."\n";
} elsif ($line=~/Connection.*closed/s) {
last CM;print "LINE=".__LINE__."\n";
}
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last CM if $count++==20;print "LINE=".__LINE__."\n";
} else { $count=0 }
if (-1<index $line,'assword:'
|| -1<index $line,'Permission denied') {
$self->{_cmd_handle}->print("\004");print "LINE=".__LINE__."\n";
}
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';print "LINE=".__LINE__."\n";
} else { $self->{_cmd_handle}->close();die "$@ $!" }
}
} $self->{_cmd_handle}->close();print "LINE=".__LINE__."\n";
delete $self->{_cmd_handle};print "LINE=".__LINE__."\n";
return 0;print "LINE=".__LINE__."\n";
}
sub get
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "Rem_Command::get() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',"\n\n ".(caller(1))[3]." $stderr at ".
$topcaller[1]." - Line $topcaller[2].\n";print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
sub put
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "Rem_Command::put() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',"\n\n ".(caller(1))[3]." $stderr at ".
$topcaller[1]." - Line $topcaller[2].\n";print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);print "LINE=".__LINE__."\n";
}
}
sub cmd_login
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Rem_Command::cmd_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $hostlabel=$_[0];print "LINE=".__LINE__."\n";
my $new_master=$_[1]||0;print "LINE=".__LINE__."\n";
my $_connect=$_[2]||'';print "LINE=".__LINE__."\n";
my $override_login_id=$_[3]||'';print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
my $cache=$_[4]||$main::cache||'';print "LINE=".__LINE__."\n";
my $timeout=$Net::FullAuto::FA_Core::timeout;print "LINE=".__LINE__."\n";
print "WE GOT HOSTLABEL=$hostlabel<==\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"WE GOT HOSTLABEL=$hostlabel<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
if ($override_login_id) {
$login_id=$override_login_id;print "LINE=".__LINE__."\n";
$su_id='';print "LINE=".__LINE__."\n";
}
print "WE ARE BACK FROM LOOKUP and IP=$ip<==\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$cdtimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$cdtimeout) {
$cdtimeout=$timeout if !$cdtimeout;print "LINE=".__LINE__."\n";
}
$login_id=&Net::FullAuto::FA_Core::username() if !$login_id;print "LINE=".__LINE__."\n";
my $cmd_handle='';my $work_dirs='';my $cmd_type='';my $smb=0;print "LINE=".__LINE__."\n";
my $ftm_type='';my $use_su_login='';my $id='';my $cygwin='';print "LINE=".__LINE__."\n";
my $su_login='';my $die='';my $login_passwd='';my $ms_su_id='';print "LINE=".__LINE__."\n";
my $ms_ms_domain='';my $ms_ms_share='';my $ms_login_id='';print "LINE=".__LINE__."\n";
my $ms_hostlabel='';my $ms_host='';my $smb_type='';print "LINE=".__LINE__."\n";
my $cmd_errmsg='';my $host='';my $output='';my $shell_pid=0;print "LINE=".__LINE__."\n";
my $retrys=0;my $login_tries=0;my $cmd_pid='';my $shell='';print "LINE=".__LINE__."\n";
my $su_scrub='';my @connect_method=();print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');
if (lc(${$ftr_cnct}[0]) eq 'smb') {
$smb=1;print "LINE=".__LINE__."\n";
if ($use eq 'hostname') {
$ms_host=$hostname;print "LINE=".__LINE__."\n";
} else {
$ms_host=$ip;print "LINE=".__LINE__."\n";
}
$ms_hostlabel=$hostlabel;print "LINE=".__LINE__."\n";
$ms_su_id=$su_id;print "LINE=".__LINE__."\n";
$ms_login_id=$login_id;print "LINE=".__LINE__."\n";
$ms_ms_domain=$ms_domain;print "LINE=".__LINE__."\n";
$ms_ms_share=$ms_share;print "LINE=".__LINE__."\n";
my $smbtimeout=$cdtimeout;print "LINE=".__LINE__."\n";
($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]);print "LINE=".__LINE__."\n";
$host=($use eq 'ip')?$ip:$hostname;print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$cdtimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$cdtimeout) {
$cdtimeout=$timeout if !$cdtimeout;print "LINE=".__LINE__."\n";
}
$cdtimeout=$smbtimeout if $cdtimeout<$smbtimeout;print "LINE=".__LINE__."\n";
$hostlabel=$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];print "LINE=".__LINE__."\n";
if (!$login_id && !$su_id) {
$ms_login_id=$login_id=&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
}
my $loginid = ($su_id) ? $su_id : $login_id;print "LINE=".__LINE__."\n";
$use_su_login=1 if $su_id;print "LINE=".__LINE__."\n";
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],
$loginid,$ms_domain,'','','smb');print "LINE=".__LINE__."\n";
#$loginid,$ms_domain,$cmd_errmsg,'','SMB_Proxy');print "LINE=".__LINE__."\n";
} elsif (exists $Hosts{$hostlabel} &&
exists $Hosts{$hostlabel}->{'Label'} &&
(lc($Hosts{$hostlabel}->{'Label'}) eq 'mozrepl' ||
$Hosts{$hostlabel}->{'Label'} eq 'Firefox MozRepl')) {
} else {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','');print "LINE=".__LINE__."\n";
}
$host=($use eq 'ip')?$ip:$hostname;print "LINE=".__LINE__."\n";
$host='localhost' if exists $same_host_as_Master{$host}
&& !exists $Hosts{$hostlabel}{'sshport'};print "LINE=".__LINE__."\n";
if ($host eq 'localhost' && exists $Hosts{$hostlabel}
&& exists $Hosts{$hostlabel}->{'Label'}
&& $Hosts{$hostlabel}->{'Label'} ne 'localhost'
&& $_connect eq 'connect_telnet') {
@connect_method=('telnet');print "LINE=".__LINE__."\n";
} elsif ($host eq 'localhost' &&
exists $Hosts{"__Master_${$}__"}{'Local'}) {
my $loc=$Hosts{"__Master_${$}__"}{'Local'};print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');print "LINE=".__LINE__."\n";
} elsif ($loc eq 'connect_ssh') {
$_connect=$loc;print "LINE=".__LINE__."\n";
@connect_method=('ssh');print "LINE=".__LINE__."\n";
} elsif ($loc eq 'connect_telnet') {
$_connect=$loc;print "LINE=".__LINE__."\n";
@connect_method=('telnet');print "LINE=".__LINE__."\n";
} elsif ($loc eq 'connect_ssh_telnet') {
$_connect=$loc;print "LINE=".__LINE__."\n";
@connect_method=('ssh','telnet');print "LINE=".__LINE__."\n";
} else {
$_connect=$loc;print "LINE=".__LINE__."\n";
@connect_method=('telnet','ssh');print "LINE=".__LINE__."\n";
}
} else { @connect_method=@{$cmd_cnct} }
my $previous_method='';my $sshloginid='';print "LINE=".__LINE__."\n";
my $ignore='';my $preferred=0;my $outpt='';my $cygdrive='';my $prompt='';print "LINE=".__LINE__."\n";
while (1) {
undef $@;print "LINE=".__LINE__."\n";
eval {
if ($hostlabel eq "__Master_${$}__" && !$new_master) {
$cmd_handle=$Net::FullAuto::FA_Core::localhost->{_cmd_handle};print "LINE=".__LINE__."\n";
$cmd_pid=$Net::FullAuto::FA_Core::localhost->{_cmd_pid};print "LINE=".__LINE__."\n";
$shell_pid=$Net::FullAuto::FA_Core::localhost->{_sh_pid};print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
my $w2loop=0;print "LINE=".__LINE__."\n";
WH: while (1) {
my $rm_cnt=-1;print "LINE=".__LINE__."\n";
CM3: foreach my $connect_method (@connect_method) {
$rm_cnt++;print "LINE=".__LINE__."\n";
if ($previous_method && !$preferred) {
if ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet) {
print "Warning, Preferred Connection ",
"$previous_method Failed\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"Warning, Preferred Connection ".
"$previous_method Failed\n"])
if $cache;print "LINE=".__LINE__."\n";
}
$preferred=1;print "LINE=".__LINE__."\n";
} else { $previous_method=$connect_method }
$previous_method=$connect_method;print "LINE=".__LINE__."\n";
if (lc($connect_method) eq 'telnet') {
eval {
my $telnetpath=$Net::FullAuto::FA_Core::gbp->('telnet');print "LINE=".__LINE__."\n";
if (exists $Hosts{"__Master_${$}__"}{'telnet'}) {
$telnetpath=$Hosts{"__Master_${$}__"}{'telnet'};print "LINE=".__LINE__."\n";
$telnetpath.='/' if $telnetpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $telnetport='';print "LINE=".__LINE__."\n";
if (exists $Hosts{$hostlabel}->{'telnetport'}) {
$telnetport=$Hosts{$hostlabel}->{'telnetport'};print "LINE=".__LINE__."\n";
}
if ($telnetport) {
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
["${telnetpath}telnet",$host,$telnetport])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch telnet subprocess");print "LINE=".__LINE__."\n";
} else {
($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 "LINE=".__LINE__."\n";
}
#print "CMD_PIDTELNETNNNNNNN=$cmd_pid<====\n";print "LINE=".__LINE__."\n";
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cdtimeout);print "LINE=".__LINE__."\n";
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];print "LINE=".__LINE__."\n";
}
$cmd_handle->telnetmode(0);print "LINE=".__LINE__."\n";
$cmd_handle->binmode(1);print "LINE=".__LINE__."\n";
$cmd_handle->output_record_separator("\r");print "LINE=".__LINE__."\n";
$cmd_handle->timeout($cdtimeout);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
#if ($rm_cnt==$#connect_method) {
if (1<=$#connect_method) {
undef $@;next;print "LINE=".__LINE__."\n";
} else {
my $die=$@;undef $@;print "LINE=".__LINE__."\n";
die $die;print "LINE=".__LINE__."\n";
}
}
while (my $line=$cmd_handle->get) {
#print "TELNET_CMD_HANDLE_LINE=$line\n";print "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,'*';print "LINE=".__LINE__."\n";
my $showline=$line;print "LINE=".__LINE__."\n";
chomp($showline=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$showline=~tr/\12/\033/;print "LINE=".__LINE__."\n";
$showline=~tr/\33//s;print "LINE=".__LINE__."\n";
$showline=~tr/\33/\12/;print "LINE=".__LINE__."\n";
$showline=~s/^\12//s;print "LINE=".__LINE__."\n";
$showline=~s/login.*$//s;print "LINE=".__LINE__."\n";
if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug) {
print $showline;print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,$showline])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG $showline
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($cmd_pid);print "LINE=".__LINE__."\n";
if ($su_id) {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.$Net::FullAuto::FA_Core::pcnt};print "LINE=".__LINE__."\n";
} else {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.$Net::FullAuto::FA_Core::pcnt};print "LINE=".__LINE__."\n";
}
my $lchl=lc($hostlabel);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::firefox||='';print "LINE=".__LINE__."\n";
if (($^O eq 'cygwin') && (-1<index $lchl,'mozrepl')
&& !($Net::FullAuto::FA_Core::firefox)) {
unshift @connect_method,'telnet';print "LINE=".__LINE__."\n";
# Let's look for Firefox
my $firefox=
'REG QUERY "HKEY_LOCAL_MACHINE\\SOFTWARE\\'.
'Mozilla\\Mozilla FireFox" 2>&1';print "LINE=".__LINE__."\n";
($firefox,$stderr)=
&Net::FullAuto::FA_Core::cmd($firefox);print "LINE=".__LINE__."\n";
chomp($firefox=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$firefox=~s/^\s*//;print "LINE=".__LINE__."\n";
if ($firefox=~/^Error:/) {
my $die=" Cannot Locate a "
."Mozilla FireFox installation"
."\n "
."needed for FullAuto repl() "
."functionality:\n"
."\n ".$firefox;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
$firefox=~
s/^.*CurrentVersion\s*REG_SZ\s*(.*?)\n.*$/$1/s;print "LINE=".__LINE__."\n";
$firefox=
'REG QUERY "HKEY_LOCAL_MACHINE\\SOFTWARE\\'.
"Mozilla\\Mozilla Firefox\\$firefox\\Main\"".
' 2>&1';print "LINE=".__LINE__."\n";
($stdout,$stderr)=
&Net::FullAuto::FA_Core::cmd(
'ps -W | grep firefox');print "LINE=".__LINE__."\n";
my $fireflag=0;print "LINE=".__LINE__."\n";
if (-1<index $stdout,'firefox') {
$fireflag=1;print "LINE=".__LINE__."\n";
}
($firefox,$stderr)=
&Net::FullAuto::FA_Core::cmd($firefox);print "LINE=".__LINE__."\n";
if ($firefox=~/^Error:/) {
my $die=" Cannot Locate a "
."Mozilla FireFox installation"
."\n "
."needed for FullAuto repl() "
."functionality:\n"
."\n ".$firefox;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
chomp($firefox=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$firefox=~s/^.*PathToExe\s*REG_SZ\s*(.*)\s*$/$1/s;print "LINE=".__LINE__."\n";
$firefox=~s/\s*$//s;print "LINE=".__LINE__."\n";
my $winff=$firefox;print "LINE=".__LINE__."\n";
($firefox,$stderr)=&Net::FullAuto::FA_Core::cmd(
"cygpath \"$firefox\"");print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::firefox=$firefox;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
# Let's look for MozRepl
my $have_mozrepl=0;print "LINE=".__LINE__."\n";
my $up=$ENV{'USERPROFILE'}||'';print "LINE=".__LINE__."\n";
if (-1<index $up,'Documents') {
$up.="\\Application Data\\Mozilla\\".
"Firefox\\Profiles\\";print "LINE=".__LINE__."\n";
} else {
$up.="\\AppData\\Roaming\\Mozilla\\".
"Firefox\\Profiles\\";print "LINE=".__LINE__."\n";
}
($up,$stderr)=&Net::FullAuto::FA_Core::cmd(
"cygpath \"$up\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
my @dirs=();print "LINE=".__LINE__."\n";
if (-e $up) {
opendir(DIR,$up);print "LINE=".__LINE__."\n";
@dirs = readdir(DIR);print "LINE=".__LINE__."\n";
closedir(DIR);print "LINE=".__LINE__."\n";
}
if (-1<$#dirs) {
HM: foreach my $profile (@dirs) {
next if $profile eq '.';print "LINE=".__LINE__."\n";
next if $profile eq '..';print "LINE=".__LINE__."\n";
if (-e $up."/$profile/extensions") {
opendir(DIR,$up."/$profile/extensions");print "LINE=".__LINE__."\n";
my @files = readdir(DIR);print "LINE=".__LINE__."\n";
closedir(DIR);print "LINE=".__LINE__."\n";
foreach my $file (@files) {
if (-1<index $file,'mozrepl') {
$have_mozrepl=1;print "LINE=".__LINE__."\n";
last HM;print "LINE=".__LINE__."\n";
}
}
}
}
}
unless ($have_mozrepl) {
eval {
die;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
my $path=$@;print "LINE=".__LINE__."\n";
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;print "LINE=".__LINE__."\n";
chomp($path);print "LINE=".__LINE__."\n";
my $cdr='';print "LINE=".__LINE__."\n";
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
"cygpath -w \"$path\"");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$winff=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
my $progpath=substr($0,0,(rindex $0,'/')+1);print "LINE=".__LINE__."\n";
my $mc=$progpath.'install_mozrepl_plugin '.
"\"$winff\""." ${cdr}mozrepl-1.1-fx.xpi";print "LINE=".__LINE__."\n";
my $mystdout='';print "LINE=".__LINE__."\n";
IO::CaptureOutput::capture sub {
system($mc);print "LINE=".__LINE__."\n";
}, \$mystdout;print "LINE=".__LINE__."\n";
}
my $fcmd="\"${firefox}\" -new-instance -repl ".
"http://www.fullautosoftware.net ".
"1>$localhost->{_work_dirs}->{_tmp}".
"repl_out.txt &";print "LINE=".__LINE__."\n";
unless ($fireflag) {
my $ro=$localhost->{_work_dirs}->{_tmp}.
"repl_out.txt";print "LINE=".__LINE__."\n";
unlink $ro if -e $ro;print "LINE=".__LINE__."\n";
my $mystdout='';print "LINE=".__LINE__."\n";
IO::CaptureOutput::capture sub {
system($fcmd);print "LINE=".__LINE__."\n";
}, \$mystdout;print "LINE=".__LINE__."\n";
my $cat_=$Net::FullAuto::FA_Core::gbp->('cat');print "LINE=".__LINE__."\n";
foreach (1..30) {
my $out=`${cat_}cat $ro`;print "LINE=".__LINE__."\n";
if (-1<index $out,'MOZREPL : Listening') {
unlink $ro;print "LINE=".__LINE__."\n";
$previous_method=0;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ff_flag=1;print "LINE=".__LINE__."\n";
next WH;print "LINE=".__LINE__."\n";
}
sleep 1;print "LINE=".__LINE__."\n";
}
$fcmd="\"${firefox}\" -new-instance -repl ".
"http://www.fullautosoftware.net".
eval {
$SIG{ALRM} = sub { die "alarm\n" };print "LINE=".__LINE__."\n";
alarm(30);print "LINE=".__LINE__."\n";
($stdout,$stderr)=$localhost->cmd($fcmd);print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
$stderr=$@ if $@;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr);print "LINE=".__LINE__."\n";
} else {
my $mystdout='';print "LINE=".__LINE__."\n";
IO::CaptureOutput::capture sub {
system($fcmd);print "LINE=".__LINE__."\n";
}, \$mystdout;print "LINE=".__LINE__."\n";
}
}
if (1<=$#connect_method) {
$stderr=$line;print "LINE=".__LINE__."\n";
next CM3;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($line);print "LINE=".__LINE__."\n";
}
}
if (-1<index $line,'CYGWIN') {
if ($su_id) {
if ($su_id ne $login_id) {
$login_id=$su_id;print "LINE=".__LINE__."\n";
} else { $su_id='' }
my $value=$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}=
$value;print "LINE=".__LINE__."\n";
}
$uname='cygwin';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'Uname'}='cygwin';print "LINE=".__LINE__."\n";
$cygwin=1;print "LINE=".__LINE__."\n";
} elsif (-1<index $line,'AIX') {
$uname='aix';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'Uname'}='aix';print "LINE=".__LINE__."\n";
}
last if $line!~/Last login/i &&
$line=~/login[: ]*$|username[: ]*$/i;print "LINE=".__LINE__."\n";
if ($line=~/(repl\d*)>\s*$/s) {
$shell=$1;print "LINE=".__LINE__."\n";
$cmd_handle->prompt("/$shell> \$/");print "LINE=".__LINE__."\n";
return $cmd_handle,$work_dirs,$uname,
$cmd_type,$ftm_type,$smb,$die,$ip,$hostname,
$cmd_pid,$shell_pid,$cygdrive,$shell;print "LINE=".__LINE__."\n";
}
}
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);print "LINE=".__LINE__."\n";
if ($cmd_handle->errmsg) {
&Net::FullAuto::FA_Core::handle_error(
$cmd_handle->errmsg);print "LINE=".__LINE__."\n";
} $cmd_type='telnet';print "LINE=".__LINE__."\n";
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect });print "LINE=".__LINE__."\n";
if ($stderr && $rm_cnt!=$#connect_method) {
$cmd_handle->close;print "LINE=".__LINE__."\n";
next CM3;print "LINE=".__LINE__."\n";
} last
} elsif (lc($connect_method) eq 'ssh') {
$sshloginid=($use_su_login)?$su_id:$login_id;print "LINE=".__LINE__."\n";
my $sshpath=$Net::FullAuto::FA_Core::gbp->('ssh');print "LINE=".__LINE__."\n";
eval {
if (exists $Hosts{"__Master_${$}__"}{'ssh'}) {
$sshpath=$Hosts{"__Master_${$}__"}{'ssh'};print "LINE=".__LINE__."\n";
$sshpath.='/' if $sshpath!~/\/$/;print "LINE=".__LINE__."\n";
}
my $sshport='';print "LINE=".__LINE__."\n";
if (exists $Hosts{$hostlabel}{'sshport'}) {
$sshport=$Hosts{$hostlabel}{'sshport'};print "LINE=".__LINE__."\n";
}
my $idntfil='';print "LINE=".__LINE__."\n";
if (exists $Hosts{$hostlabel}{'identity_file'}) {
$idntfil=$Hosts{$hostlabel}{'identity_file'};print "LINE=".__LINE__."\n";
}
if ($sshport) {
if ($idntfil) {
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
["${sshpath}ssh",'-v',"-i$idntfil","-p$sshport",
"$sshloginid\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");print "LINE=".__LINE__."\n";
} else {
($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");print "LINE=".__LINE__."\n";
}
} elsif ($idntfil) {
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
["${sshpath}ssh",'-v',"-i$idntfil","$sshloginid\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");print "LINE=".__LINE__."\n";
} 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");print "LINE=".__LINE__."\n";
}
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cdtimeout);print "LINE=".__LINE__."\n";
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];print "LINE=".__LINE__."\n";
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];print "LINE=".__LINE__."\n";
}
$cmd_handle->telnetmode(0);print "LINE=".__LINE__."\n";
$cmd_handle->binmode(1);print "LINE=".__LINE__."\n";
$cmd_handle->output_record_separator("\r");print "LINE=".__LINE__."\n";
$cmd_handle->timeout($cdtimeout);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
if ($rm_cnt==$#connect_method) {
undef $@;next;print "LINE=".__LINE__."\n";
} else {
my $die=$@;undef $@;print "LINE=".__LINE__."\n";
die $die;print "LINE=".__LINE__."\n";
}
}
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';print "LINE=".__LINE__."\n";
## 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_');print "LINE=".__LINE__."\n";
if ($stderr) {
if ($rm_cnt!=$#connect_method) {
$cmd_handle->close;print "LINE=".__LINE__."\n";
next CM3;print "LINE=".__LINE__."\n";
} else {
die $stderr;print "LINE=".__LINE__."\n";
}
}
} 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;print "LINE=".__LINE__."\n";
unless ($cmd_errmsg) {
if ($use eq 'hostname') {
$ms_host=$hostname;print "LINE=".__LINE__."\n";
} else {
$ms_host=$ip;print "LINE=".__LINE__."\n";
}
$ms_hostlabel=$hostlabel;print "LINE=".__LINE__."\n";
$ms_su_id=$su_id;print "LINE=".__LINE__."\n";
$ms_login_id=$login_id;print "LINE=".__LINE__."\n";
$ms_ms_domain=$ms_domain;print "LINE=".__LINE__."\n";
$ms_ms_share=$ms_share;print "LINE=".__LINE__."\n";
($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]);print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$cdtimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$cdtimeout) {
$cdtimeout=$timeout if !$cdtimeout;print "LINE=".__LINE__."\n";
}
if (!$login_id && !$su_id) {
$ms_login_id=$login_id=
&Net::FullAuto::FA_Core::username();print "LINE=".__LINE__."\n";
}
} my $loginid = ($su_id) ? $su_id : $login_id;print "LINE=".__LINE__."\n";
$use_su_login=1 if $su_id;print "LINE=".__LINE__."\n";
$login_passwd=
&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],
$loginid,$ms_domain,$cmd_errmsg,
'','smb');print "LINE=".__LINE__."\n";
#'','SMB_Proxy');print "LINE=".__LINE__."\n";
$cmd_errmsg='';$cmd_type='';print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} 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 (10)
print "\n Logging into $host ($hostlabel) via ",
"$cmd_type . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostlabel) via ".
"$cmd_type . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (10) into $host ($hostlabel) via ",
"$cmd_type . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging (10) into $host ($hostlabel) via ".
"$cmd_type . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (10) into $host ($hostlabel) via ",
"$cmd_type . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
## Send password.
$cmd_handle->print($login_passwd);print "LINE=".__LINE__."\n";
$cmd_handle=&Rem_Command::wait_for_prompt(
$cmd_handle,$timeout,\@connect_method,$hostlabel);print "LINE=".__LINE__."\n";
# Find out what the shell is.
($shell,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
'set | '.$Net::FullAuto::FA_Core::gbp->('grep').'grep SHELL=');print "LINE=".__LINE__."\n";
$shell=~s/SHELL=//;print "LINE=".__LINE__."\n";
$shell=~s/^['"]//;print "LINE=".__LINE__."\n";
$shell=~s/['"]$//;print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
my $ctt=2;print "LINE=".__LINE__."\n";
while ($ctt--) {
($uname,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'uname');print "LINE=".__LINE__."\n";
if (!$uname && !$stderr) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
} last if $uname;print "LINE=".__LINE__."\n";
}
die 'no-uname' if !$uname || $stderr;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "\nRem_Command::cmd_login() UNAME: ==>$uname<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
if (lc($uname)=~/cygwin/) {
$uname='cygwin';$cygwin=1;print "LINE=".__LINE__."\n";
} elsif ($uname eq 'AIX') {
$uname='aix';print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=$uname;print "LINE=".__LINE__."\n";
($shell_pid,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'echo $$');print "LINE=".__LINE__."\n";
$shell_pid||=0;print "LINE=".__LINE__."\n";
$shell_pid=~/^(\d+)$/;print "LINE=".__LINE__."\n";
$shell_pid=$1;print "LINE=".__LINE__."\n";
if (!$shell_pid) {
$cmd_handle->print;my $ct=0;print "LINE=".__LINE__."\n";
$cmd_handle->print(
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;echo $$;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');print "LINE=".__LINE__."\n";
my $allins='';$ct=0;print "LINE=".__LINE__."\n";
while (1) {
eval {
while (my $line=$cmd_handle->get(
Timeout=>5)) {
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
$allins.=$line;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"SHELLPIDLINEEEERRRRRRRR=$allins<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($allins=~/!!(.*)%%/) {
$shell_pid=$1;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"SHELLPIDRRRRR**AAAAA=$shell_pid<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
$cmd_handle->print;print "LINE=".__LINE__."\n";
} elsif (!$shell_pid && $ct++<50) {
$cmd_handle->print;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
last
}
}
}
chomp($shell_pid=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
if ($su_id) {
${$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{'cmd_su_'.$Net::FullAuto::FA_Core::pcnt}}[2]=$shell_pid;print "LINE=".__LINE__."\n";
} else {
${$Net::FullAuto::FA_Core::Processes{$hostlabel}{$login_id}
{'cmd_id_'.$Net::FullAuto::FA_Core::pcnt}}[2]=$shell_pid;print "LINE=".__LINE__."\n";
}
if (!$cygwin) {
if ($su_id) {
$su_login=1;print "LINE=".__LINE__."\n";
my ($ignore,$su_err)=
&Net::FullAuto::FA_Core::su($cmd_handle,$hostlabel,$su_id,
$su_id,$hostname,$ip,$use,$uname,$_connect,$cmd_type,
[],$stderr);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;print "LINE=".__LINE__."\n";
}
} else {
&Net::FullAuto::FA_Core::acquire_fa_lock(8712);print "LINE=".__LINE__."\n";
($cygdrive,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
$Net::FullAuto::FA_Core::gbp->('mount')."mount -p");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock(8712);print "LINE=".__LINE__."\n";
$cygdrive=~s/^.*(\/\S+).*$/$1/s;print "LINE=".__LINE__."\n";
}
}
if (!$uname) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
($uname,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'uname');print "LINE=".__LINE__."\n";
$cmd_handle->print;print "LINE=".__LINE__."\n";
if (!$uname) {
$cmd_handle->print(
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;uname;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');print "LINE=".__LINE__."\n";
my $allins='';my $ct=0;print "LINE=".__LINE__."\n";
while (my $line=$cmd_handle->get) {
chomp($line=~tr/\0-\37\177-\377//d);print "LINE=".__LINE__."\n";
$allins.=$line;print "LINE=".__LINE__."\n";
if ($allins=~/!!(.*)%%/) {
$uname=$1;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} else {
$cmd_handle->print;print "LINE=".__LINE__."\n";
} last if $ct++==10;print "LINE=".__LINE__."\n";
}
}
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
if (lc($uname)=~/cygwin/) {
$uname='cygwin';$cygwin=1;print "LINE=".__LINE__."\n";
} elsif ($uname eq 'AIX') {
$uname='aix';print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=$uname;print "LINE=".__LINE__."\n";
}
if ($smb && $ms_ms_share) {
my $msloginid = ($ms_su_id) ? $ms_su_id : $ms_login_id;print "LINE=".__LINE__."\n";
my $mspasswd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$msloginid,
$ms_share,$cmd_errmsg);print "LINE=".__LINE__."\n";
my $host=$ms_host;print "LINE=".__LINE__."\n";
my $mswin_cwd='';print "LINE=".__LINE__."\n";
($mswin_cwd,$smb_type,$stderr)=
&File_Transfer::connect_share($cmd_handle,
$ms_hostlabel);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-3') if $stderr;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
${$work_dirs}{_pre_mswin}=
${$work_dirs}{_cwd_mswin}=$mswin_cwd;print "LINE=".__LINE__."\n";
${$work_dirs}{_pre}=${$work_dirs}{_cwd}='';print "LINE=".__LINE__."\n";
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0] ]
},'cd '.${$work_dirs}{_tmp});print "LINE=".__LINE__."\n";
if ($stderr) {
@FA_Core::tran=();print "LINE=".__LINE__."\n";
my $die="Cannot cd to TransferDir -> "
.${$work_dirs}{_tmp_mswin}
."\n $stderr";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
$Net::FullAuto::FA_Core::tran[0]=${$work_dirs}{_tmp};print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;print "LINE=".__LINE__."\n";
} else {
# ADD CODE HERE FOR DYNAMIC TMP DIR DISCOVERY
&Net::FullAuto::FA_Core::handle_error(
"No TransferDir Defined for $hostlabel");print "LINE=".__LINE__."\n";
}
} 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,'*';print "LINE=".__LINE__."\n";
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,{ _cmd_handle=>$cmd_handle,
_uname=>$uname },$cmd_type,$cygdrive,
$_connect);print "LINE=".__LINE__."\n";
my $curdir='';print "LINE=".__LINE__."\n";
if ($uname eq 'cygwin') {
($curdir,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ]
},'pwd');print "LINE=".__LINE__."\n";
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;print "LINE=".__LINE__."\n";
my $cdr='';print "LINE=".__LINE__."\n";
if (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};print "LINE=".__LINE__."\n";
} else {
($cdr,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ]
},"cygpath -w \"$curdir\"");print "LINE=".__LINE__."\n";
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;print "LINE=".__LINE__."\n";
$cdr=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
}
${$work_dirs}{_pre_mswin}=
${$work_dirs}{_cwd_mswin}=$cdr.'\\\\';print "LINE=".__LINE__."\n";
${$work_dirs}{_pre}=${$work_dirs}{_cwd}=$curdir;print "LINE=".__LINE__."\n";
} else {
($curdir,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'pwd');print "LINE=".__LINE__."\n";
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;print "LINE=".__LINE__."\n";
$curdir.='/' if $curdir ne '/';print "LINE=".__LINE__."\n";
${$work_dirs}{_pre}=${$work_dirs}{_cwd}=$curdir;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"CURDIRDETERMINED!!!!!!=$curdir<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
if ($@) {
$cmd_errmsg=$@;print "LINE=".__LINE__."\n";
#print "WHAT IS THE CMD_ERR=$@\n";<STDIN>;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
#&Net::FullAuto::FA_Core::handle_error("$@ and LINE=$outpt",'__cleanup__') if $outpt;print "LINE=".__LINE__."\n";
if ($retrys<2) {
$retrys++;print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);print "LINE=".__LINE__."\n";
$cmd_handle->close;next;print "LINE=".__LINE__."\n";
} else {
my $host= $hostname ? $hostname : $ip;print "LINE=".__LINE__."\n";
$cmd_errmsg="$@\n\n While Attempting "
. "Login to $host\n -> HostLabel "
. "\'$hostlabel\'\n\n";print "LINE=".__LINE__."\n";
if (-1<index $cmd_errmsg,'timed-out') {
$cmd_errmsg.=" \'$hostlabel\'\n\n Current Timeout "
."Setting is -> $cdtimeout seconds.";print "LINE=".__LINE__."\n";
} &Net::FullAuto::FA_Core::handle_error($cmd_errmsg);print "LINE=".__LINE__."\n";
}
} my $die_login_id='';print "LINE=".__LINE__."\n";
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"};print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if $shell_pid
&& &Net::FullAuto::FA_Core::testpid($shell_pid);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);print "LINE=".__LINE__."\n";
$cmd_handle->close;print "LINE=".__LINE__."\n";
} 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"};print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if $shell_pid
&& &Net::FullAuto::FA_Core::testpid($shell_pid);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);print "LINE=".__LINE__."\n";
$cmd_handle->close;print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron) {
if ($su_login || $use_su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id,'');print "LINE=".__LINE__."\n";
$die_login_id=$su_id;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id,'');print "LINE=".__LINE__."\n";
$die_login_id=$login_id;print "LINE=".__LINE__."\n";
}
}
my $unam='';print "LINE=".__LINE__."\n";
if (-1<index $cmd_errmsg,'Cannot su to') {
@connect_method=@{$cmd_cnct};print "LINE=".__LINE__."\n";
if (2<=$retrys) {
$unam=$uname;print "LINE=".__LINE__."\n";
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$su_id);print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);print "LINE=".__LINE__."\n";
} else { $retrys++;next }
} elsif (2<=$retrys) {
$unam=$uname;print "LINE=".__LINE__."\n";
$unam='MS Windows' if $unam eq 'cygwin';print "LINE=".__LINE__."\n";
$cmd_errmsg.="\n WARNING! - You may be in"
." Danger of locking out $unam\n"
." $hostlabel ID - "
."$login_id!\n\n";print "LINE=".__LINE__."\n";
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);print "LINE=".__LINE__."\n";
} else { $retrys++;next }
} else { $retrys++;next }
}
my $c_t=$cmd_type;$c_t=~s/^(.)/uc($1)/e;print "LINE=".__LINE__."\n";
if (-1<index $cmd_errmsg,'Could not resolve hostname') {
($die=$cmd_errmsg)=~s/: hostname/:\n\n hostname/s;print "LINE=".__LINE__."\n";
} else {
#print "IS THIS REALLY WHERE WE ARE DYINGMMMMMMMMMM and CMDERR=$cmd_errmsg<==\n";<STDIN>;print "LINE=".__LINE__."\n";
$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";print "LINE=".__LINE__."\n";
}
$die.="\n While Attempting "
. "Login to $host\n -> HostLabel "
. "\'$hostlabel\'\n\n";print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::fa_login.=$die;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
}
$cmd_handle=Bad_Handle->new($hostlabel,$die);print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} else { last }
last if $die;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
#$Net::FullAuto::FA_Core::log=0 if $logreset;print "LINE=".__LINE__."\n";
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 clean_filehandle
{
return &Net::FullAuto::FA_Core::clean_filehandle(@_);print "LINE=".__LINE__."\n";
}
sub wait_for_prompt {
my $cmd_handle=$_[0];print "LINE=".__LINE__."\n";
my $timeout=$_[1];print "LINE=".__LINE__."\n";
my @connect_method=@{$_[2]};print "LINE=".__LINE__."\n";
my $hostlabel=$_[3];print "LINE=".__LINE__."\n";
my $from_su=$_[4]||'';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::uhray=&Net::FullAuto::FA_Core::get_prompt();print "LINE=".__LINE__."\n";
unless ($from_su) {
$cmd_handle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');print "LINE=".__LINE__."\n";
}
my $previous_method='';my $sshloginid='';my $ignore='';print "LINE=".__LINE__."\n";
my $preferred=0;my $outpt='';my $cygdrive='';my $prompt='';print "LINE=".__LINE__."\n";
my $output='';my $ct=0;my $tymeout=1;print "LINE=".__LINE__."\n";
while (1) {
if (($ct==1) && (5<$timeout)) {
$tymeout=5;print "LINE=".__LINE__."\n";
} elsif (($ct==2) && (10<$timeout)) {
$tymeout=10;print "LINE=".__LINE__."\n";
} elsif (2<$ct) {
$tymeout=$timeout;print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
while (my $line=$cmd_handle->get(Timeout=>$tymeout)) {
$SIG{ALRM} = sub { die "read timed-out\n" }; # \n required
alarm $timeout+1;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
chomp($line=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$outpt.=$line;print "LINE=".__LINE__."\n";
$output.=$line;print "LINE=".__LINE__."\n";
$output=~s/login:.*//s;print "LINE=".__LINE__."\n";
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];print "LINE=".__LINE__."\n";
shift @connect_method;print "LINE=".__LINE__."\n";
} else { last }
}
$output=~s/^\s*//s;print "LINE=".__LINE__."\n";
$output=~s/\s*//s;print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
if ($output=~/^.*(Perm.*)$/s) {
my $one=$1;print "LINE=".__LINE__."\n";
if ($output=~/^.*(No more auth.*)$/s) {
die "$1\n";print "LINE=".__LINE__."\n";
} die "$one\n";print "LINE=".__LINE__."\n";
}
die "$output\n";print "LINE=".__LINE__."\n";
} elsif ($line=~/Connection (?:closed|reset)/s) {
alarm 0;print "LINE=".__LINE__."\n";
die "$output\n";print "LINE=".__LINE__."\n";
}
if ($outpt=~
/${$Net::FullAuto::FA_Core::uhray}[0]_-(.*)$/s) {
$prompt=$1;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif ($outpt=~/^((?:bash)*[\$%#>])\s?cmd \//m) {
$prompt=$1;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
alarm 0;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
alarm 0;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
my $ev_err=$@;print "LINE=".__LINE__."\n";
if ($ev_err=~/read timed-out/s && $ct++<3) {
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();print "LINE=".__LINE__."\n";
$cmd_handle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');print "LINE=".__LINE__."\n";
} elsif ($sshloginid &&
$ev_err=~/Permission denied/s) {
if ($ev_err=~/No more auth/s) {
die $ev_err;print "LINE=".__LINE__."\n";
} else {
$cmd_handle->print(&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$sshloginid,'',$@,
'__force__'));print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();print "LINE=".__LINE__."\n";
$cmd_handle->print('cmd /Q /C "set /A '
.${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2]
.'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');print "LINE=".__LINE__."\n";
}
} else { die $ev_err }
} else { last }
}
$cmd_handle->prompt('/_funkyPrompt_$/');print "LINE=".__LINE__."\n";
$cmd_handle->print(
"export PS1=_funkyPrompt_;unset PROMPT_COMMAND");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
return $cmd_handle;print "LINE=".__LINE__."\n";
} ## END OF &wait_for_prompt
sub ftpcmd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Rem_Command::ftpcmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $handle=$_[0];my $cache='';print "LINE=".__LINE__."\n";
my $cmd=$_[1];my $ftperr='';my $return_all=0;print "LINE=".__LINE__."\n";
if (1<$#_) {
foreach my $i (2..$#_) {
if ($_[$i] eq '__return_all_output__') {
$return_all=1;print "LINE=".__LINE__."\n";
} elsif (-1<index $_[$i],'Cache::FileCache') {
$cache=$_[$i];print "LINE=".__LINE__."\n";
} elsif ((-1<index $_[$i],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[$i]->chi_root_class)) {
$cache=$_[$i];print "LINE=".__LINE__."\n";
}
}
}
my $hostlabel=$handle->{_hostlabel}->[1]
|| $handle->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
my $ftm_type=$handle->{_ftm_type};print "LINE=".__LINE__."\n";
my $output='';my $nfound='';my $allbytes='';print "LINE=".__LINE__."\n";
my $ready='';my $more='';my $retrys=0;print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';my $hashcount=0;print "LINE=".__LINE__."\n";
my $keepcount=0;my $gpfile='';my $seen=0;print "LINE=".__LINE__."\n";
$gpfile=unpack('a3',$cmd) if 2<length $cmd;print "LINE=".__LINE__."\n";
my $prcnt=0;my $firstvisit=0;my $gf='';print "LINE=".__LINE__."\n";
if ($gpfile eq 'get' || $gpfile eq 'put') {
my $ex=($gpfile eq 'put')?'!':'';print "LINE=".__LINE__."\n";
($gpfile=$cmd)=~s/^...\s+(.*)$/$1/;print "LINE=".__LINE__."\n";
chomp $gpfile;my $lsline='';print "LINE=".__LINE__."\n";
($gf=$gpfile)=~s/^["']([^"']*)["'].*$/$1/;print "LINE=".__LINE__."\n";
if ($gf eq $gpfile && (-1<index $gpfile,' ')) {
$gf=substr($gf,0,(index $gf,' '));print "LINE=".__LINE__."\n";
}
$gf=~s/\+/\\\+/g;print "LINE=".__LINE__."\n";
my $gfp='';print "LINE=".__LINE__."\n";
if ($ftm_type eq 'sftp') {
$gfp=' '.substr($gf,0,(rindex $gf,'/'));print "LINE=".__LINE__."\n";
$gfp='' if (-1==index $gfp,'/');print "LINE=".__LINE__."\n";
}
($output,$stderr)=&ftpcmd($handle,"${ex}ls$gfp",$cache);print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return $output,$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-13','__cleanup__');print "LINE=".__LINE__."\n";
}
} my $gpf=substr($gf,(rindex $gf,'/')+1);print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $output) {
if (-1<index $line,'total 0') {
if (wantarray) {
return '',"$cmd: No Files Found";print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error("$cmd: No Files Found");print "LINE=".__LINE__."\n";
}
}
next if unpack('a1',$line) ne '-';print "LINE=".__LINE__."\n";
$line=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$line=~tr/\0-\37\177-\377//d;print "LINE=".__LINE__."\n";
if ($line=~s/$gpf$//) {
$lsline=$line;last;print "LINE=".__LINE__."\n";
}
}
if (!$lsline) {
($output,$stderr)=&ftpcmd($handle,"${ex}ls -l$gfp",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $output) {
if (-1<index $line,'total 0') {
if (wantarray) {
return '',"$cmd: No Files Found";print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error("$cmd: No Files Found");print "LINE=".__LINE__."\n";
}
}
next if unpack('a1',$line) ne '-';print "LINE=".__LINE__."\n";
$line=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$line=~tr/\0-\37\177-\377//d;print "LINE=".__LINE__."\n";
if ($handle->{_luname} eq 'cygwin') {
if ($line=~/$gf$/i) {
$lsline=$line;last;print "LINE=".__LINE__."\n";
}
} else {
if ($line=~/$gf$/) {
$lsline=$line;last;print "LINE=".__LINE__."\n";
}
}
}
}
my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;print "LINE=".__LINE__."\n";
my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;print "LINE=".__LINE__."\n";
$lsline=~s/^.*\s+($rx1|$rx2)$/$1/;print "LINE=".__LINE__."\n";
($allbytes)=$lsline=~/^(\d+)\s+[JFMASOND]\w\w\s+\d+\s+\S+\s+.*$/;print "LINE=".__LINE__."\n";
if ($ftm_type ne 'sftp') {
($output,$stderr)=&ftpcmd($handle,'hash',$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
} else { $gpfile='' }
print $Net::FullAuto::FA_Core::MRLOG "\nGOING TO RUN FTP CMD: $cmd\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
eval {
$handle->{_ftp_handle}->print($cmd);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
&Net::FullAuto::FA_Core::handle_error(
"$@\n and COMMAND=$cmd and GPFILE=$gpfile".
"and FTP_HANDLE=$handle->{_ftp_handle}\n",'-4');print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($handle->{_ftp_handle}->errmsg)
if $handle->{_ftp_handle}->errmsg;print "LINE=".__LINE__."\n";
my $cmdflag=0;my $tcmd='';my $loop=0;print "LINE=".__LINE__."\n";
while (1) {
my $starttime=time();print "LINE=".__LINE__."\n";
eval {
while (1) {
if (!$more) {
$nfound = select
$ready=${${*{$handle->{_ftp_handle}}}{net_telnet}}{fdmask},
'', '', $handle->{_ftp_handle}->timeout;print "LINE=".__LINE__."\n";
} $output='';print "LINE=".__LINE__."\n";
if ($nfound > 0 || $more) {
sysread $handle->{_ftp_handle},
$output,
${${*{$handle->{_ftp_handle}}}{net_telnet}}{blksize},
0;print "LINE=".__LINE__."\n";
$more='' if $more;print "LINE=".__LINE__."\n";
} elsif (!$stdout) {
$starttime=time();print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"(S)FTP-OUTPUT: ==>$output<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$output=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$output=~tr/\0-\11\13-\37\177-\377//d;print "LINE=".__LINE__."\n";
$stdout.=$output;print "LINE=".__LINE__."\n";
if ($gpfile && (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug)) {
$hashcount=$output;print "LINE=".__LINE__."\n";
$hashcount=($hashcount=~tr/#//);print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";print "LINE=".__LINE__."\n";
}
$firstvisit=1;print "LINE=".__LINE__."\n";
}
$hashcount=$hashcount*1024;
$keepcount=$keepcount+$hashcount;print "LINE=".__LINE__."\n";
$keepcount=$allbytes if $allbytes<$keepcount;print "LINE=".__LINE__."\n";
my $plin="$keepcount bytes, ";print "LINE=".__LINE__."\n";
$prcnt=$keepcount/$allbytes;print "LINE=".__LINE__."\n";
if (unpack('a1',$prcnt) eq '1') {
$prcnt=100;print "LINE=".__LINE__."\n";
} else { $prcnt=substr($prcnt,2,2) }
substr($prcnt,0,1)='' if unpack('a1',$prcnt) eq '0';print "LINE=".__LINE__."\n";
$plin.="${prcnt}% of $gpfile transferred . . . ";print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
STDOUT->autoflush(1);print "LINE=".__LINE__."\n";
printf("\r% 0s",$plin);print "LINE=".__LINE__."\n";
STDOUT->autoflush(0);print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"FTP STDOUT: ==>$plin<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
sleep 1;print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n" if $keepcount==$allbytes;print "LINE=".__LINE__."\n";
}
} elsif (!$keepcount) {
foreach my $line (split /\n+/, $output) {
$line=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$line=~tr/\0-\11\13-\37\177-\377//d;print "LINE=".__LINE__."\n";
$line=~tr/#//d;print "LINE=".__LINE__."\n";
$line=~s/s*ftp> ?$//s if !($line=~s/^\s*$//m);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $upcnt=$line=~/Upload/gs;print "LINE=".__LINE__."\n";
$upcnt||=0;print "LINE=".__LINE__."\n";
if ($upcnt) {
if ($seen) { next }
$seen=1
}
$line=~s/Upload.*$//s if 1<$upcnt;print "LINE=".__LINE__."\n";
my $ftcnt=$line=~/Fetch/gs;print "LINE=".__LINE__."\n";
$ftcnt||=0;print "LINE=".__LINE__."\n";
if ($ftcnt) {
if ($seen) { next }
$seen=1
}
$line=~s/Fetch.*$//s if 1<$ftcnt;print "LINE=".__LINE__."\n";
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')
|| (-1==index $line,'not found')
|| (-1==index $line,"Couldn't")) {
my $tl=$line;print "LINE=".__LINE__."\n";
$tl=~s/[\r|\n]*//sg;print "LINE=".__LINE__."\n";
if ($line=~s/^\n*Uploading/\n\nUploading/gs) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
STDOUT->autoflush(1);print "LINE=".__LINE__."\n";
print $line."\n\n";print "LINE=".__LINE__."\n";
STDOUT->autoflush(0);print "LINE=".__LINE__."\n";
}
} elsif ($line=~s/^\n*Fetch/\n\nFetch/gs) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
STDOUT->autoflush(1);print "LINE=".__LINE__."\n";
print $line,"\n\n";print "LINE=".__LINE__."\n";
STDOUT->autoflush(0);print "LINE=".__LINE__."\n";
}
} elsif ($line=~/(stalled -|\d\d:\d\d *E*T*A*)$/) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
STDOUT->autoflush(1);print "LINE=".__LINE__."\n";
printf("\r% 0s",$line);print "LINE=".__LINE__."\n";
STDOUT->autoflush(0);print "LINE=".__LINE__."\n";
}
} elsif (!$cmdflag &&
$stdout=~/^((?:get|put) ["][^"]+["]).*/s) {
my $printthis=$1;print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print $printthis;print "LINE=".__LINE__."\n";
}
$cmdflag=1;print "LINE=".__LINE__."\n";
} elsif ($cmd!~/$tl/) {
$cmdflag=1;print "LINE=".__LINE__."\n";
} else {
$tcmd=$line;print "LINE=".__LINE__."\n";
$cmdflag=1 if $cmd eq $tcmd;print "LINE=".__LINE__."\n";
}
}
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 "LINE=".__LINE__."\n";
print "\n" if !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print "\n\n" if !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
print "\n" if !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
print "\n" if !$Net::FullAuto::FA_Core::quiet;print "LINE=".__LINE__."\n";
}
}
}
if ($allbytes && $line=~/(\d+) bytes/) {
my $bytestransferred=$1;print "LINE=".__LINE__."\n";
my $warn="WARNING! - The transfer of file $gf\n"
." size $allbytes bytes\, "
."aborted at $bytestransferred "
."\n bytes transferred.";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$warn,'__return__','__warn__')
if $allbytes ne $bytestransferred;print "LINE=".__LINE__."\n";
}
}
}
}
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,'*';print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->print("\004");print "LINE=".__LINE__."\n";
die "421 Timeout - $ftm_type read timed out";print "LINE=".__LINE__."\n";
}
$loop=0;print "LINE=".__LINE__."\n";
$output=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$output=~tr/\0-\11\13-\37\177-\377//d;print "LINE=".__LINE__."\n";
$output=~tr/ //d;print "LINE=".__LINE__."\n";
if ($output=~/s*ftp> ?$/s || $stdout=~/s*ftp> ?$/s || $more) {
$nfound=select
$ready=${${*{$handle->{_ftp_handle}}}{net_telnet}}{fdmask},
'', '', 0;print "LINE=".__LINE__."\n";
if ($nfound) {
$more=1;next;print "LINE=".__LINE__."\n";
} else {
$stdout=~s/^(.*?)(\012|\013)+//s;print "LINE=".__LINE__."\n";
my $last=0;print "LINE=".__LINE__."\n";
if ($stdout=~s/s*ftp> ?$//s) {
$last=1;print "LINE=".__LINE__."\n";
}
$stdout=~tr/#//d;print "LINE=".__LINE__."\n";
last if $last;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
} $starttime=time();print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->print("\004");print "LINE=".__LINE__."\n";
$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 "LINE=".__LINE__."\n";
print "$ftm_type read timed out1 and OUTPUT=$output<=======\n";print "LINE=".__LINE__."\n";
if ($retrys<2) {
$retrys++;print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->print("\004");print "LINE=".__LINE__."\n";
$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__;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($tmot,'__cleanup__');print "LINE=".__LINE__."\n";
}
}
} print "\n" if $output && $gpfile
&& $keepcount && !($Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::quiet) || $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
if ($stdout=~/^5\d+\s+$/m && $stdout!~/^5\d+\s+bytes.*$/m) {
$stdout=~/^(5.*)$/m;print "LINE=".__LINE__."\n";
$stderr=$1;print "LINE=".__LINE__."\n";
$stderr=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$stderr=~tr/\0-\37\177-\377//d;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
} elsif ((-1<index $stdout,":5") && $stdout=~/^(.*:5\d\d\s.*)$/m) {
my $line=$1;print "LINE=".__LINE__."\n";
$line=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$line=~tr/\0-\37\177-\377//d;print "LINE=".__LINE__."\n";
$stderr="$line\n $!" if $line!~/^\d+\s+bytes/;print "LINE=".__LINE__."\n";
} elsif ((-1<index $stdout,'file access p')
|| (-1<index $stdout,'not found')
|| (-1<index $stdout,"Couldn't")) {
print $Net::FullAuto::FA_Core::MRLOG
"$ftm_type File ERROR: ==>$stdout<==\n\n".
" and HOSTLABEL=$hostlabel\n\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$stdout;print "LINE=".__LINE__."\n";
} else {
return $stdout;print "LINE=".__LINE__."\n";
}
} elsif ((-1<index $stdout,'421 Service not')
|| (-1<index $stdout,'421 Timeout')
|| (-1<index $stdout,'Not connected')
|| (-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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fctimeout=$Net::FullAuto::FA_Core::cltimeout;print "LINE=".__LINE__."\n";
} elsif (!$fctimeout) {
$fctimeout=$timeout if !$fctimeout;print "LINE=".__LINE__."\n";
}
my $ftm_errmsg='';print "LINE=".__LINE__."\n";
my $host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->print('bye');print "LINE=".__LINE__."\n";
my $sav_ftp_handle='';my $ftp_handle='';print "LINE=".__LINE__."\n";
while (my $line=$handle->{_ftp_handle}->get) {
last if $line=~/_funkyPrompt_$/s;print "LINE=".__LINE__."\n";
if ($line=~/logout/s) {
$sav_ftp_handle=$handle->{_ftp_handle};print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->close;print "LINE=".__LINE__."\n";
($ftp_handle,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',$handle->{_connect});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}=$ftp_handle->{_cmd_handle};print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
} elsif ($handle->{_ftp_handle} eq
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
substr($type,0,3)='ftp';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}=
$handle->{_ftp_handle};print "LINE=".__LINE__."\n";
}
}
}
}
}
}
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);print "LINE=".__LINE__."\n";
if ($stderr) {
$stderr="$stdout\n $stderr";print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);print "LINE=".__LINE__."\n";
}
} elsif (!$handle->{_ftp_handle}) {
if (wantarray) {
return '',$stdout;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stdout);print "LINE=".__LINE__."\n";
}
}
} my $ftm_passwd='';print "LINE=".__LINE__."\n";
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,
$ms_share,$ftm_errmsg,'__su__');print "LINE=".__LINE__."\n";
#if ($ftm_passwd ne 'DoNotSU!') {
# $su_login=1;print "LINE=".__LINE__."\n";
#} else { $su_id='' }
$su_id=''
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg);print "LINE=".__LINE__."\n";
}
my $fm_cnt=-1;print "LINE=".__LINE__."\n";
foreach my $connect_method (@{$ftr_cnct}) {
$fm_cnt++;my $gotname=0;print "LINE=".__LINE__."\n";
if (lc($connect_method) eq 'ftp') {
my $go_next=0;print "LINE=".__LINE__."\n";
eval {
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->print(
"${Net::FullAuto::FA_Core::ftppath}ftp $host");print "LINE=".__LINE__."\n";
## Look for Name Prompt.
while (my $line=$handle->{_ftp_handle}->get) {
my $tline=$line;print "LINE=".__LINE__."\n";
$tline=~s/Name.*$//s;print "LINE=".__LINE__."\n";
if (-1<index $tline,'ftp: connect:') {
$tline=~/^.*connect:\s*(.*?\n).*$/s;print "LINE=".__LINE__."\n";
if ((-1==index $tline,'Address already in use')
&& (-1==index $tline,'Connection timed out')) {
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"ftp: connect: $1");print "LINE=".__LINE__."\n";
}
} else {
$handle->{_ftp_handle}->close
if defined fileno $handle->{_ftp_handle};print "LINE=".__LINE__."\n";
sleep int $handle->{_ftp_handle}->timeout/3;print "LINE=".__LINE__."\n";
($handle->{_ftp_handle},$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',
$handle->{_connect});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}=$ftp_handle->{_cmd_handle};print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->print(
"${Net::FullAuto::FA_Core::ftppath}ftp $host");print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftp';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}
{$type}=$handle->{_ftp_handle};print "LINE=".__LINE__."\n";
last FH1;print "LINE=".__LINE__."\n";
}
}
}
}
$tline=$line;print "LINE=".__LINE__."\n";
$tline=~s/Name.*$//s;print "LINE=".__LINE__."\n";
}
} 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;print "LINE=".__LINE__."\n";
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($tline);print "LINE=".__LINE__."\n";
}
}
print "TLIN=$tline"
if !$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "TLIN=$tline"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (-1<index $tline,
'ftp: connect: Connection timed out') {
$tline=~s/s*ftp> ?\s*$//s;print "LINE=".__LINE__."\n";
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($tline);print "LINE=".__LINE__."\n";
}
} elsif ((-1<index $line,'A remote host refused')
|| (-1<index $line,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
$line=~s/^(.*)?\n.*/$1/s;print "LINE=".__LINE__."\n";
my $die=$line;print "LINE=".__LINE__."\n";
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;print "LINE=".__LINE__."\n";
} else {
$die.="Destination Host - $host, HostLabel "
."- $hostlabel\n refused an "
."attempted connect operation.\n "
."Check for a running FTP daemon on "
.$hostlabel;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
if ($line=~/Name.*[: ]+$/si) {
$gotname=1;last;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
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.";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
} elsif ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($@);print "LINE=".__LINE__."\n";
}
} next if $go_next || !$gotname;print "LINE=".__LINE__."\n";
if ($su_id) {
$handle->{_ftp_handle}->print($su_id);print "LINE=".__LINE__."\n";
} else {
$handle->{_ftp_handle}->print($login_id);print "LINE=".__LINE__."\n";
}
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$handle->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$ftm_type,
_connect=>$handle->{_connect} });print "LINE=".__LINE__."\n";
$ftm_type='ftp';print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
$handle->{_ftp_handle}->print('bye');print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$handle->{_ftp_handle});print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
} last
} elsif (lc($connect_method) eq 'sftp') {
my $sftploginid=($su_id)?$su_id:$login_id;print "LINE=".__LINE__."\n";
my $sshport='';print "LINE=".__LINE__."\n";
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');print "LINE=".__LINE__."\n";
my $sp=$Net::FullAuto::FA_Core::sftpport;print "LINE=".__LINE__."\n";
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';print "LINE=".__LINE__."\n";
}
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'identity_file'}) {
$sshport.='-i'.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'identity_file'}.' ';print "LINE=".__LINE__."\n";
}
$handle->{_ftp_handle}->print(
$Net::FullAuto::FA_Core::gbp->('sftp').'sftp '.
"${sshport}$sftploginid\@$host");print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
substr($type,0,3)='ftp';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$handle->{_ftp_handle};print "LINE=".__LINE__."\n";
last FH;print "LINE=".__LINE__."\n";
}
}
}
}
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (11)
print "\n Logging into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (11) into $host ($hostlabel) via ",
"sftp . . .\n\n";print "LINE=".__LINE__."\n";
$cache->set($cache->{'key'},[0,
"\n Logging (11) into $host ($hostlabel) via ".
"sftp . . .\n\n"])
if $cache;print "LINE=".__LINE__."\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (11) into $host ($hostlabel) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
## Wait for password prompt.
my $ignore='';print "LINE=".__LINE__."\n";
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$handle->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$ftm_type,
_connect=>$handle->{_connect} });print "LINE=".__LINE__."\n";
$ftm_type='sftp';print "LINE=".__LINE__."\n";
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
$handle->{_ftp_handle}->print("bye");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$handle->{_ftp_handle});print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
} 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] ]
);print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->prompt("/s*ftp> ?\$/");print "LINE=".__LINE__."\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
$ftm_passwd,$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
return $stderr;print "LINE=".__LINE__."\n";
}
}
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
return $stderr;print "LINE=".__LINE__."\n";
}
}
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}",
$cache);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{cd}=
$Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd};print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
return $stderr;print "LINE=".__LINE__."\n";
}
}
} 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}",
$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
return $stderr;print "LINE=".__LINE__."\n";
}
}
}
if (0) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'pwd',$cache)
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
print "FTPCMD--PWD=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
}
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}",
$cache);print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd}=
$Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd};print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
return $stderr;print "LINE=".__LINE__."\n";
}
}
} 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},
$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
return $stderr;print "LINE=".__LINE__."\n";
}
}
}
if ($gpfile && $ftm_type ne 'sftp') {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'hash',$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) {
return '',$stderr;print "LINE=".__LINE__."\n";
} else {
return $stderr;print "LINE=".__LINE__."\n";
}
}
}
$stdout='';$stderr='';print "LINE=".__LINE__."\n";
$handle->{_ftp_handle}->print($cmd);print "LINE=".__LINE__."\n";
next
} elsif ($ftm_type eq 'sftp') {
$stdout=~s/^$cmd\s*(.*)\s*sftp>\s*$/$1/s;print "LINE=".__LINE__."\n";
$stdout=~tr/\r//d;print "LINE=".__LINE__."\n";
$stdout=~s/\s*$//s;print "LINE=".__LINE__."\n";
if (exists $handle->{_cmd_handle} && $handle->{_cmd_handle}) {
if ($stdout=~/Couldn\'t canonicalise:/s) {
if ($cmd=~/^ls$|^ls /) {
($output,$stderr)=$handle->cmd($cmd);print "LINE=".__LINE__."\n";
if ($stderr) {
$stderr=$stdout;print "LINE=".__LINE__."\n";
} else { $stdout=$output }
} elsif ($cmd=~/^cd /) {
($output,$stderr)=$handle->cmd('pwd');print "LINE=".__LINE__."\n";
if ($stderr) {
$stderr=$stdout;print "LINE=".__LINE__."\n";
} else {
$output=~s/^.*direcotory: (.*)$/$1/;print "LINE=".__LINE__."\n";
my $out='';print "LINE=".__LINE__."\n";
($out,$stderr)=$handle->cmd($cmd);print "LINE=".__LINE__."\n";
if ($stderr) {
$stderr=$stdout;print "LINE=".__LINE__."\n";
} else {
chomp $output;print "LINE=".__LINE__."\n";
($out,$stderr)=$handle->cmd("cd $output");print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
($output,$stderr)=$handle->cmd($cmd);print "LINE=".__LINE__."\n";
} else {
delete $GLOBAL{'nested_ls'};print "LINE=".__LINE__."\n";
}
if ($stderr) {
$stderr=$stdout;print "LINE=".__LINE__."\n";
} elsif (-1<index $stdout,'t stat remote file') {
$stderr=$stdout;print "LINE=".__LINE__."\n";
} 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='';print "LINE=".__LINE__."\n";
if ($cmd=~/^get\s+\"((?:\/|[A-Za-z]:).*)\"$/) {
my $path=$1;print "LINE=".__LINE__."\n";
$path=~/^(.*)[\/|\\]([^\/|\\]+)$/;print "LINE=".__LINE__."\n";
my $dir=$1;my $file=$2;my $getfile='';print "LINE=".__LINE__."\n";
my $testf=&Net::FullAuto::FA_Core::test_file($handle,
$path);print "LINE=".__LINE__."\n";
if ($testf eq 'WRITE' || $testf eq 'READ') {
if (exists $handle->{_work_dirs}->{_tmp}) {
($output,$stder)=$handle->cmd("cp -p $path ".
$handle->{_work_dirs}->{_tmp});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stder)
if $stder;print "LINE=".__LINE__."\n";
$getfile=$handle->{_work_dirs}->{_tmp}.
'/'.$file;print "LINE=".__LINE__."\n";
print "COPIED and GETFILE=$getfile<==\n";#<STDIN>;print "LINE=".__LINE__."\n";
} elsif (exists
$handle->{_work_dirs}->{_tmp_mswin}) {
print "COPIED and GETFILE222=$getfile<==\n";#<STDIN>;print "LINE=".__LINE__."\n";
($output,$stder)=$handle->cmd("cp -p $path ".
$handle->{_work_dirs}->{_tmp_mswin});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stder)
if $stder;print "LINE=".__LINE__."\n";
$getfile=$handle->{_work_dirs}->{_tmp_mswin}.
'\\'.$file;print "LINE=".__LINE__."\n";
}
($output,$stderr)=
&Rem_Command::ftpcmd(
$handle,"get $getfile",$cache);print "LINE=".__LINE__."\n";
if (!$stderr) {
($output,$stderr)=$handle->cmd(
"rm -f $getfile");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;print "LINE=".__LINE__."\n";
} $stdout=$output;print "LINE=".__LINE__."\n";
}
}
}
} 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='';print "LINE=".__LINE__."\n";
foreach my $lin (split /^/, $stdout) {
$line.=" $lin" if unpack('a1',$lin) eq '4';print "LINE=".__LINE__."\n";
}
$stdout='';print "LINE=".__LINE__."\n";
$stderr=$line;print "LINE=".__LINE__."\n";
} elsif ($stdout=~/ftp: \w+: /) {
my $line='';print "LINE=".__LINE__."\n";
foreach my $lin (split /^/, $stdout) {
$line.=" $lin";print "LINE=".__LINE__."\n";
}
$stdout='';print "LINE=".__LINE__."\n";
$stderr=$line;print "LINE=".__LINE__."\n";
} else {
my $c='';print "LINE=".__LINE__."\n";
($c=$cmd)=~s/\+/\\\+/sg;print "LINE=".__LINE__."\n";
$stdout=~s/^$c\s*(.*)\s+s*ftp>\s*$/$1/s;print "LINE=".__LINE__."\n";
my $tmpso=$stdout;$stdout='';print "LINE=".__LINE__."\n";
}
if (!$stderr && $gpfile) {
($output,$stderr)=&ftpcmd($handle,'hash',$cache)
if $ftm_type ne 'sftp';print "LINE=".__LINE__."\n";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
}
print "\nINFO: Rem_Command::ftpcmd() <<<<<<<RETURNING>>>>>>>:\n ",
"STDOUT=$stdout<== and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
#$Net::FullAuto::FA_Core::log=0 if $logreset;print "LINE=".__LINE__."\n";
if (wantarray) {
return $stdout,$stderr;print "LINE=".__LINE__."\n";
} elsif (!$stdout && $stderr) {
return $stderr;print "LINE=".__LINE__."\n";
} else { return $stdout }
}
}
sub repl
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Rem_Command::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $self=(defined $Net::FullAuto::FA_Core::newrepl)?
$Net::FullAuto::FA_Core::newrepl:$_[0];print "LINE=".__LINE__."\n";
my $command=$_[1];$command||='';my $output='';print "LINE=".__LINE__."\n";
while (1) {
$self->{_cmd_handle}->print($command);print "LINE=".__LINE__."\n";
eval {
while (my $line=$self->{_cmd_handle}->get(Timeout=>30)) {
print $Net::FullAuto::FA_Core::MRLOG
"REPL LINE=>$line<=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
#print "REPLLINE=$line\n";print "LINE=".__LINE__."\n";
$output.=$line;print "LINE=".__LINE__."\n";
last if $output=~s/\n*repl\d*>\s*$//;print "LINE=".__LINE__."\n";
last if $output=~/Host context unloading/s;print "LINE=".__LINE__."\n";
last if $output=~/Connection closed by/s;print "LINE=".__LINE__."\n";
if ($output=~/[.][.][.][.][>]/) {
$self->{_cmd_handle}->print(';');print "LINE=".__LINE__."\n";
sleep 2;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
if ($@ || $output=~/Connection closed by/s) {
#print "GOING FOR NEW SELF\n";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print("\004");print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$self->{_cmd_pid},$kill_arg);print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->close;print "LINE=".__LINE__."\n";
# ($output,$stderr)=$Net::FullAuto::FA_Core::localhost->cmd('ps -e');print "LINE=".__LINE__."\n";
#print "PS OUT=$output\n";<STDIN>;print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::newrepl=
Net::FullAuto::FA_Core::connect_mozrepl();print "LINE=".__LINE__."\n";
$self=$Net::FullAuto::FA_Core::newrepl;print "LINE=".__LINE__."\n";
$output='';print "LINE=".__LINE__."\n";
undef $@;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} else { last }
}
$output=~s/^\s*//s;print "LINE=".__LINE__."\n";
substr($output,0,(length $command))='';print "LINE=".__LINE__."\n";
$output=~s/^\s*//s;print "LINE=".__LINE__."\n";
chomp($output=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
my $error=$output if $output=~/^[!][!][!]|back to creation context/;print "LINE=".__LINE__."\n";
$error=$output if -1<index $output,'!!! SyntaxError:';print "LINE=".__LINE__."\n";
$error=$output if $output=~/Connection closed by/s;print "LINE=".__LINE__."\n";
my $die='';print "LINE=".__LINE__."\n";
if ($error) {
$error="FATAL ERROR! - MozRepl returned the"
."\n Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n ".$error;print "LINE=".__LINE__."\n";
}
if (wantarray) {
$output='' if $error;print "LINE=".__LINE__."\n";
$error||='';print "LINE=".__LINE__."\n";
return $output,$error;print "LINE=".__LINE__."\n";
} elsif ($error) {
&Net::FullAuto::FA_Core::handle_error($error);print "LINE=".__LINE__."\n";
} else {
return $output;print "LINE=".__LINE__."\n";
}
}
sub cmd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Rem_Command::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];my $cache='';print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
my @args=@_;shift @args;shift @args;print "LINE=".__LINE__."\n";
my $command=$_[1];$command||='';my $delay=0;print "LINE=".__LINE__."\n";
my $ftp=0;my $live=0;my $display=0;my $log=0;print "LINE=".__LINE__."\n";
my $wantarray= wantarray ? wantarray : '';print "LINE=".__LINE__."\n";
my $cmtimeout='X';my $svtimeout='X';my $sem='';print "LINE=".__LINE__."\n";
my $notrap=0;my $ignore='';my $login_retry=0;print "LINE=".__LINE__."\n";
my $allow_no_output=0;print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
if (defined $_[2] && $_[2]) {
if ($_[2]=~/^[0-9]+/) {
$cmtimeout=$_[2];print "LINE=".__LINE__."\n";
} else {
my $arg=lc($_[2]);print "LINE=".__LINE__."\n";
if ($arg eq '__ftp__') {
$ftp=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__log__') {
$log=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__notrap__') {
$notrap=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__delay__') {
$delay=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;print "LINE=".__LINE__."\n";
} elsif (-1<index $_[2],'Cache::FileCache') {
$cache=$_[2];print "LINE=".__LINE__."\n";
} elsif ((-1<index $_[2],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[2]->chi_root_class)) {
$cache=$_[2];print "LINE=".__LINE__."\n";
} elsif ($wantarray) {
return 0,'Third Argument for Timeout Value is not Whole Number';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
'Third Argument for Timeout Value is not Whole Number')
}
}
} my $login_id='';print "LINE=".__LINE__."\n";
if (defined $_[3] && $_[3]) {
my $arg=lc($_[3]);print "LINE=".__LINE__."\n";
if ($arg eq '__ftp__') {
$ftp=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__log__') {
$log=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__notrap__') {
$notrap=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;print "LINE=".__LINE__."\n";
} elsif (-1<index $_[3],'Cache::FileCache') {
$cache=$_[3];print "LINE=".__LINE__."\n";
} elsif ((-1<index $_[3],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[3]->chi_root_class)) {
$cache=$_[3];print "LINE=".__LINE__."\n";
} else {
$login_id=$_[3];print "LINE=".__LINE__."\n";
}
}
while (1) {
my $cmd_prompt='';my $cmdprompt='';my $ms_cmd_prompt='';print "LINE=".__LINE__."\n";
if (defined $_[4] && $_[4]) {
my $arg=lc($_[4]);print "LINE=".__LINE__."\n";
if ($arg eq '__ftp__') {
$ftp=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__log__') {
$log=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__notrap__') {
$notrap=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;print "LINE=".__LINE__."\n";
} elsif (-1<index $_[4],'Cache::FileCache') {
$cache=$_[4];print "LINE=".__LINE__."\n";
} elsif ((-1<index $_[4],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[4]->chi_root_class)) {
$cache=$_[4];print "LINE=".__LINE__."\n";
} elsif (0) {
my $tmp_cmd_prompt=$cmd_prompt=$_[4];print "LINE=".__LINE__."\n";
if (unpack('a2',$cmd_prompt) ne '(?' &&
($cmd_prompt=~/\|\|/s || $cmd_prompt=~/\|[Mm]\|/s)) {
$cmd_prompt=~s/^(.*)(?:\|\||\|[Mm]\|)//s;print "LINE=".__LINE__."\n";
$tmp_cmd_prompt=$1;print "LINE=".__LINE__."\n";
pos($cmd_prompt)=0;print "LINE=".__LINE__."\n";
while ($cmd_prompt=~/(\|\||\|[Mm]\|)(.*)/g) {
if ($1 eq '||') {
$tmp_cmd_prompt.="|$2";print "LINE=".__LINE__."\n";
} else {
$ms_cmd_prompt.="|$2";print "LINE=".__LINE__."\n";
}
}
}
$cmd_prompt=
qr/$tmp_cmd_prompt/ if unpack('a2',$cmd_prompt) ne '(?';
}
} elsif (!$ftp) {
$cmd_prompt=substr($self->{_cmd_handle}->prompt,1,-2);print "LINE=".__LINE__."\n";
}
if (defined $_[5] && $_[5]) {
my $arg=lc($_[5]);print "LINE=".__LINE__."\n";
if ($arg eq '__ftp__') {
$ftp=1;$arg='';print "LINE=".__LINE__."\n";
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;$arg='';print "LINE=".__LINE__."\n";
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__log__') {
$log=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__notrap__') {
$notrap=1;print "LINE=".__LINE__."\n";
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;print "LINE=".__LINE__."\n";
} elsif (-1<index $_[5],'Cache::FileCache') {
$cache=$_[5];print "LINE=".__LINE__."\n";
} elsif ((-1<index $_[5],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[5]->chi_root_class)) {
$cache=$_[5];print "LINE=".__LINE__."\n";
} else {
if (&Net::FullAuto::FA_Core::test_semaphore($_[5])) {
if ($wantarray) {
return 0,"Semaphore Blocking Command";print "LINE=".__LINE__."\n";
} else { return 'Semaphore Blocking Command' }
} else {
&Net::FullAuto::FA_Core::acquire_fa_lock($_[5]);print "LINE=".__LINE__."\n";
$sem=$_[5];print "LINE=".__LINE__."\n";
}
}
}
if (!$ftp && (grep{lc($_) eq '__ftp__'}@_)) {
$ftp=1;print "LINE=".__LINE__."\n";
} elsif (!$allow_no_output &&
(grep{lc($_) eq '__allow_no_output__'}@_)) {
$allow_no_output=1;print "LINE=".__LINE__."\n";
} elsif (!$live && (grep{lc($_) eq '__live__'}@_)) {
$live=1;print "LINE=".__LINE__."\n";
} elsif (!$display && (grep{lc($_) eq '__display__'}@_)) {
$ftp=1;print "LINE=".__LINE__."\n";
} elsif (!$log && (grep{lc($_) eq '__log__'}@_)) {
$log=1;print "LINE=".__LINE__."\n";
} elsif (!$notrap && (grep{lc($_) eq '__notrap__'}@_)) {
$notrap=1;print "LINE=".__LINE__."\n";
} elsif (!$delay && (grep{lc($_) eq '__delay__'}@_)) {
$delay=1;print "LINE=".__LINE__."\n";
} elsif ($login_retry==0 && (grep{lc($_) eq '__retry_on_error__'}@_)) {
$login_retry=-1;print "LINE=".__LINE__."\n";
} elsif (!$cache &&
(grep{/Cache::FileCache|Moose::Meta::Class::__ANON__::SERIAL/}@_)) {
foreach my $i (0..$#_) {
if (-1<index $_[$i],'Cache::FileCache') {
$cache=$_[$i];print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif ((-1<index $_[$i],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[$i]->chi_root_class)) {
$cache=$_[$i];print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
}
}
}
if ($cmtimeout eq 'X') {
if ($ftp) {
$cmtimeout=$self->{_ftp_handle}->timeout;print "LINE=".__LINE__."\n";
$svtimeout=$self->{_ftp_handle}->timeout;print "LINE=".__LINE__."\n";
} else {
$cmtimeout=$self->{_cmd_handle}->timeout;print "LINE=".__LINE__."\n";
$svtimeout=$self->{_cmd_handle}->timeout;print "LINE=".__LINE__."\n";
}
} elsif ($ftp) {
$svtimeout=$self->{_ftp_handle}->timeout;print "LINE=".__LINE__."\n";
$self->{_ftp_handle}->timeout($cmtimeout);print "LINE=".__LINE__."\n";
} else {
$svtimeout=$self->{_cmd_handle}->timeout;print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->timeout($cmtimeout);print "LINE=".__LINE__."\n";
}
my $caller=(caller(1))[3];print "LINE=".__LINE__."\n";
$caller='' unless defined $caller;print "LINE=".__LINE__."\n";
my $fullerror='';my $allines='';print "LINE=".__LINE__."\n";
my $hostlabel=$self->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
if ($login_id) {
my $new_cmd='';print "LINE=".__LINE__."\n";
($new_cmd,$stderr)=
Rem_Command::new('Rem_Command',$hostlabel,
'__new_master__',
$self->{_connect});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;print "LINE=".__LINE__."\n";
($stdout,$stderr)=$new_cmd->cmd($command,@args);print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($new_cmd->{_cmd_pid},$kill_arg) if
&Net::FullAuto::FA_Core::testpid($new_cmd->{_cmd_pid});print "LINE=".__LINE__."\n";
$new_cmd->{_cmd_handle}->close;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock($sem) if $sem;print "LINE=".__LINE__."\n";
return $stdout,$stderr if $wantarray;print "LINE=".__LINE__."\n";
return $stdout if !$stderr;print "LINE=".__LINE__."\n";
return $stderr;print "LINE=".__LINE__."\n";
}
my $output='';my $stdout='';my $stderr='';my $pid_ts='';print "LINE=".__LINE__."\n";
my $end=0;my $newtel='';my $restart='';my $syntax=0;print "LINE=".__LINE__."\n";
my $doeval='';my $dots='';my $dcnt=0;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
eval {
$stdout='';print "LINE=".__LINE__."\n";
$stderr='';print "LINE=".__LINE__."\n";
$end=0;print "LINE=".__LINE__."\n";
my $line='';my $testline='';print "LINE=".__LINE__."\n";
my $testcmd='';my $ms_cmd='';print "LINE=".__LINE__."\n";
($ms_cmd=$command)=~tr/ //s;print "LINE=".__LINE__."\n";
$ms_cmd=(-1<index lc($command),'cmd /c') ? 1 : 0;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($self->{_uname} ne 'cygwin') {
($output,$stderr)=Rem_Command::cmd($self,
'uname',@args);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
$stderr="remote OS is $output - NOT a cygwin system!\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr);print "LINE=".__LINE__."\n";
}
$pid_ts=$self->{_cmd_pid}.'_'.$Net::FullAuto::FA_Core::invoked[0]
.'_'.$Net::FullAuto::FA_Core::increment++;print "LINE=".__LINE__."\n";
push @FA_Core::pid_ts, $pid_ts;print "LINE=".__LINE__."\n";
my $t=$self->{_work_dirs}->{_tmp_mswin}.'\\';print "LINE=".__LINE__."\n";
$t=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$t=~s/\\$//mg;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print($str);print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
my $cmmd='';print "LINE=".__LINE__."\n";
if (-1<index $command,"\n") {
my @command=split /\n/,$command;my $ccnt=0;print "LINE=".__LINE__."\n";
foreach my $cmd (@command) {
($cmmd=$cmd)=~s/^\s*[cC][mM][dD]\s+\/[cC]\s+(.*)$/$1/;print "LINE=".__LINE__."\n";
$cmmd=~tr/\'/\"/;print "LINE=".__LINE__."\n";
$cmmd=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$cmmd=~s/\\$//mg;print "LINE=".__LINE__."\n";
$cmmd=~s/\"/\\\"/g;print "LINE=".__LINE__."\n";
if (!$ccnt++) {
if (unpack('a4',$cmmd) eq 'set ') {
$str="echo \"$cmmd\""
." > ${t}cmd${pid_ts}.bat";print "LINE=".__LINE__."\n";
} else {
$str="echo \"$cmmd 2>${t}err${pid_ts}.txt "
."1>${t}out${pid_ts}"
.".txt\" > ${t}cmd${pid_ts}.bat";print "LINE=".__LINE__."\n";
}
$self->{_cmd_handle}->print($str);print "LINE=".__LINE__."\n";
my $lastDB7=0;print "LINE=".__LINE__."\n";
DB7: while (1) {
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;print "LINE=".__LINE__."\n";
if ($line=~/^$cmd_prompt$/) {
$lastDB7=1;last
} last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
}; last if $lastDB7;print "LINE=".__LINE__."\n";
if ($@) {
if (-1<index $@,'read timed-out') {
next;print "LINE=".__LINE__."\n";
} else { die "$@ $!" }
}
}
$output=join '',$self->{_cmd_handle}->cmd(
String => $str,
Timeout => $cmtimeout
);print "LINE=".__LINE__."\n";
} else {
if (unpack('a4',$cmmd) eq 'set ') {
$str="echo \"$cmmd\""
." >> ${t}cmd${pid_ts}.bat";print "LINE=".__LINE__."\n";
} else {
$str="echo \"$cmmd 2>>${t}err${pid_ts}.txt "
."1>>${t}out${pid_ts}"
.".txt\" >> ${t}cmd${pid_ts}.bat";print "LINE=".__LINE__."\n";
}
$self->{_cmd_handle}->print($str);print "LINE=".__LINE__."\n";
my $lastDB8=0;print "LINE=".__LINE__."\n";
DB8: while (1) {
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;print "LINE=".__LINE__."\n";
if ($line=~/^$cmd_prompt$/) {
$lastDB8=1;last
} last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
}; last if $lastDB8;print "LINE=".__LINE__."\n";
if ($@) {
if (-1<index $@,'read timed-out') {
next;print "LINE=".__LINE__."\n";
} else { die "$@ $!" }
}
}
}
}
} else {
($cmmd=$command)=~s/^\s*[cC][mM][dD]\s+\/[cC]\s+(.*)$/$1/;print "LINE=".__LINE__."\n";
$cmmd=~tr/\'/\"/;print "LINE=".__LINE__."\n";
$cmmd=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$cmmd=~s/\\$//mg;print "LINE=".__LINE__."\n";
$cmmd=~s/\"/\\\"/g;print "LINE=".__LINE__."\n";
$str="echo \"$cmmd 2>${t}err${pid_ts}.txt 1>${t}out${pid_ts}"
.".txt\" > ${t}cmd${pid_ts}.bat";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print($str);print "LINE=".__LINE__."\n";
my $lastDB9=0;print "LINE=".__LINE__."\n";
DB9: while (1) {
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;print "LINE=".__LINE__."\n";
if ($line=~/^$cmd_prompt$/) {
$lastDB9=1;last
} last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
}; last if $lastDB9;print "LINE=".__LINE__."\n";
if ($@) {
if (-1<index $@,'read timed-out') {
next;print "LINE=".__LINE__."\n";
} else { die "$@ $!" }
}
}
}
$str="echo \"echo \"DONE\" > ${t}end${pid_ts}.flg\" >>"
." ${t}cmd${pid_ts}.bat";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print($str);print "LINE=".__LINE__."\n";
my $lastDB10=0;print "LINE=".__LINE__."\n";
DB10: while (1) {
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;print "LINE=".__LINE__."\n";
if ($line=~/^$cmd_prompt$/) {
$lastDB10=1;last
} last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
}; last if $lastDB10;print "LINE=".__LINE__."\n";
if ($@) {
if (-1<index $@,'read timed-out') {
next;print "LINE=".__LINE__."\n";
} else { die "$@ $!" }
}
}
$self->{_cmd_handle}->
print("echo \"exit\" >> ${t}cmd${pid_ts}.bat");print "LINE=".__LINE__."\n";
my $lastDB11=0;print "LINE=".__LINE__."\n";
DB11: while (1) {
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;print "LINE=".__LINE__."\n";
if ($line=~/^$cmd_prompt$/) {
$lastDB11=1;last
} last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
};print "LINE=".__LINE__."\n";
if ($lastDB11) {
$self->{_cmd_handle}->print("echo ECHO");print "LINE=".__LINE__."\n";
eval {
my $echo=0;print "LINE=".__LINE__."\n";
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;print "LINE=".__LINE__."\n";
if ($line=~/ECHO/s) {
last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
$echo=1;print "LINE=".__LINE__."\n";
} elsif ($echo==1) {
last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
} last if $lastDB11;print "LINE=".__LINE__."\n";
if ($@) {
if (-1<index $@,'read timed-out') {
next;print "LINE=".__LINE__."\n";
} else { die "$@ $!" }
}
}
#print "RUNNING COMMANDBAT $cmmd\n";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print("cmd /c start ${t}cmd${pid_ts}.bat");print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
}
}
}
}
my $err_cownt=0;my $nowerr_cownt=0;print "LINE=".__LINE__."\n";
my $err_size=0;my $err_size_save=0;print "LINE=".__LINE__."\n";
($output,$stderr)=$self->cmd('pwd');print "LINE=".__LINE__."\n";
print "BIGGOOOPUTPUT=$output<== and PRE=$self->{_work_dirs}->{_pre} and TMP=$self->{_work_dirs}->{_tmp} and CWD=$self->{_work_dirs}->{_cwd}\n";print "LINE=".__LINE__."\n";
my $c=$self->{_work_dirs}->{_tmp}||
$self->{_work_dirs}->{_tmp_mswin};print "LINE=".__LINE__."\n";
my $loop_time=0;print "LINE=".__LINE__."\n";
LK: while (1) {
#$loop_time=time() if !$loop_time;print "LINE=".__LINE__."\n";
#if ($cmtimeout<time()-$loop_time) {
# ($output,$stderr)=$self->cmd("ls -l err${pid_ts}.txt");print "LINE=".__LINE__."\n";
# &Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
# my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;print "LINE=".__LINE__."\n";
# my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;print "LINE=".__LINE__."\n";
# $output=~s/^.*\s+($rx1|$rx2)$/$1/;print "LINE=".__LINE__."\n";
# $output=~/^(\d+)\s+[JFMASOND]\w\w\s+\d+\s+\S+\s+.*$/;print "LINE=".__LINE__."\n";
# my $size=$1;print "LINE=".__LINE__."\n";
#print "CMDOUTPUTSIZE=$size<==\n";print "LINE=".__LINE__."\n";
# last if $size;print "LINE=".__LINE__."\n";
# $loop_time=0;print "LINE=".__LINE__."\n";
#}
my $shell_cmd="if\n[[ -f ${c}end${pid_ts}.flg ]]\nthen" .
"\necho END\nelse\necho LOOKING\nfi\n";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print($shell_cmd);print "LINE=".__LINE__."\n";
if ($self->{_cmd_handle}->errmsg) {
my $err=$self->{_cmd_handle}->errmsg;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($err);print "LINE=".__LINE__."\n";
} my $looptime=0;$allines='';print "LINE=".__LINE__."\n";
while (1) {
my $line=$self->{_cmd_handle}->
get(Timeout=>$cmtimeout);print "LINE=".__LINE__."\n";
$allines.=$line;print "LINE=".__LINE__."\n";
last if $allines=~/^(END|LOOKING)/m;print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
$looptime=time() if !$looptime;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->timeout($svtimeout);print "LINE=".__LINE__."\n";
if ($wantarray) {
die $lv_errmsg;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
}
}
$allines=~s/\s*$//s;print "LINE=".__LINE__."\n";
if ($allines=~/^END/m) {
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
my $err_outt='';print "LINE=".__LINE__."\n";
($err_outt,$stderr)=$self->cmd("ls -l ${c}err${pid_ts}.txt");print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
$err_size='';print "LINE=".__LINE__."\n";
($err_size=$err_outt)
=~s/^\S+\s+\d+\s+\S+\s+\S+\s+(\d+).*$/$1/s;print "LINE=".__LINE__."\n";
if ($err_size!~/^\d+$/) {
($err_size=$err_outt)
=~s/^\S+\s+\d+\s+\S+\s+\S+\s+\S+\s+(\d+).*$/$1/s;print "LINE=".__LINE__."\n";
}
if ($err_size=~/^\d+$/) {
if ($err_size==$err_size_save &&
$nowerr_cownt+3<$err_cownt++) {
#my $cat_err='';print "LINE=".__LINE__."\n";
#($cat_err,$stderr)=$self->cmd(
# "cat ${c}err${pid_ts}.txt");print "LINE=".__LINE__."\n";
#print "CATERRRRRR=$cat_err<==\n";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
last LK;print "LINE=".__LINE__."\n";
#&Net::FullAuto::FA_Core::handle_error($cat_err);print "LINE=".__LINE__."\n";
} else { $err_size_save=$err_size }
}
last LK;print "LINE=".__LINE__."\n";
}
if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) {
print $Net::FullAuto::FA_Core::blanklines;print "LINE=".__LINE__."\n";
print "\n Gathering MSWin Output $dots";print "LINE=".__LINE__."\n";
if ($dcnt++<5) {
$dots.=" .";print "LINE=".__LINE__."\n";
} else { $dots='';$dcnt=0 }
print "\n\n From Command => $cmmd\n\n";print "LINE=".__LINE__."\n";
} sleep 1;print "LINE=".__LINE__."\n";
}
print "GETTING THIS=${c}out${pid_ts}.txt\n";print "LINE=".__LINE__."\n";
my $trandir='';print "LINE=".__LINE__."\n";
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}\"",
$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=&ftpcmd($self,
"get \"${c}out${pid_ts}.txt\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-3')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_lcd}\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=&ftpcmd($self,
"get \"${c}out${pid_ts}.txt\"",$cache);print "LINE=".__LINE__."\n";
}
if ($err_size) {
if ($self->{_work_dirs}->{_lcd} ne
$self->{_work_dirs}->{_tmp_lcd}) {
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_tmp_lcd}\"",
$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=&ftpcmd($self,
"get \"${c}err${pid_ts}.txt\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-3')
if $stderr;print "LINE=".__LINE__."\n";
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_lcd}\"",
$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;print "LINE=".__LINE__."\n";
} else {
($output,$stderr)=&ftpcmd($self,
"get \"${c}err${pid_ts}.txt\"",$cache);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;print "LINE=".__LINE__."\n";
}
}
}
if ($Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp}) {
$trandir=$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp'};print "LINE=".__LINE__."\n";
if (substr($trandir,-1) ne '/') {
$trandir.='/';print "LINE=".__LINE__."\n";
}
}
($stdout,$stderr)=$localhost->cmd(
"cat ${trandir}out${pid_ts}.txt");print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="$stderr\n\n From Command -> "
."\"cat ${trandir}out${pid_ts}.txt\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
my $cmd_error='';my $error='';print "LINE=".__LINE__."\n";
if ($err_size) {
($cmd_error,$stderr)=$localhost->cmd(
"cat ${trandir}err${pid_ts}.txt");print "LINE=".__LINE__."\n";
if ($stderr) {
my $die="$stderr\n\n From Command -> "
."\"cat ${trandir}err${pid_ts}.txt\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-4');print "LINE=".__LINE__."\n";
}
}
my $out='';print "LINE=".__LINE__."\n";
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__');print "LINE=".__LINE__."\n";
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\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
($out,$error)=$localhost->cmd(
"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp_mswin'}
."\\\\err${pid_ts}.txt",
'__live__');print "LINE=".__LINE__."\n";
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\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
&Net::FullAuto::FA_Core::handle_error(
"$cmd_error\n\n From Command -> $cmmd",'-8')
if $cmd_error && !$wantarray;print "LINE=".__LINE__."\n";
} else {
($out,$error)=$localhost->cmd(
"rm -rf ${trandir}out${pid_ts}.txt");print "LINE=".__LINE__."\n";
if ($error) {
my $die="$error\n\n From Command -> "
."\"rm -rf ${trandir}out${pid_ts}.txt\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
($out,$error)=$localhost->cmd(
"rm -rf ${trandir}err${pid_ts}.txt");print "LINE=".__LINE__."\n";
if ($error) {
my $die="$error\n\n From Command -> "
."\"rm -rf ${trandir}err${pid_ts}.txt\"";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die);print "LINE=".__LINE__."\n";
}
}
$str="echo \"del ${t}rm${pid_ts}.bat\""
." >> ${t}rm${pid_ts}.bat";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print($str);print "LINE=".__LINE__."\n";
$allines='';print "LINE=".__LINE__."\n";
while (my $line=$self->{_cmd_handle}->
get(Timeout=>$cmtimeout)) {
$allines.=$line;print "LINE=".__LINE__."\n";
last if $allines=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
$self->{_cmd_handle}->print("cmd /c ${t}rm${pid_ts}.bat");print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
if ($cmd_error) {
my $error="$cmd_error\n\n From Command -> $cmmd";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($error) if !$wantarray;print "LINE=".__LINE__."\n";
die "$error\n\n at $topcaller[0] "
."$topcaller[1] line ".__LINE__.".\n";print "LINE=".__LINE__."\n";
}
} elsif ($ftp) {
($stdout,$stderr)
=&ftpcmd($self->{_cmd_handle},$command,$cache);print "LINE=".__LINE__."\n";
if ($stderr) {
my $host=($self->{_hostlabel}->[1])
? $self->{_hostlabel}->[1]
: $self->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
my $die="$stderr\n\n From Command -> "
."\"$command\"\n for \'$host\'\.";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($die,'-10');print "LINE=".__LINE__."\n";
}
} else {
my $bckgrd=0;print "LINE=".__LINE__."\n";
$bckgrd=1 if $command=~s/[\t ][&](?>\s*)$//s;print "LINE=".__LINE__."\n";
my $live_command='';print "LINE=".__LINE__."\n";
if ($command=~/^cd[\t ]/) {
$live_command="$command 2>&1";print "LINE=".__LINE__."\n";
if (-1<$#{$self->{_hostlabel}} &&
$self->{_hostlabel}->[$#{$self->{_hostlabel}}]
eq "__Master_${$}__") {
my $lcd=$command;$lcd=~s/^cd[\t ]*//;print "LINE=".__LINE__."\n";
chdir $lcd;print "LINE=".__LINE__."\n";
}
} else {
$live_command='('.$command.')'." | sed -e 's/^/stdout: /' 2>&1";print "LINE=".__LINE__."\n";
}
$live_command.=' &' if $bckgrd;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->timeout($cmtimeout);print "LINE=".__LINE__."\n";
$live_command=~s/\\\\/\\/g;print "LINE=".__LINE__."\n";
$live_command=~s/\\/\\\\/g;print "LINE=".__LINE__."\n";
$live_command=~s/\\$//mg;print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print($live_command);print "LINE=".__LINE__."\n";
my $growoutput='';my $ready='';my $firstout=0;print "LINE=".__LINE__."\n";
my $fulloutput='';my $lastline='';my $errflag='';print "LINE=".__LINE__."\n";
my $test_out='';my $first=-1;#my $starttime=0;print "LINE=".__LINE__."\n";
my $starttime=time();my $restart_attempt=1;my $nl='';print "LINE=".__LINE__."\n";
my $select_timeout=2;my $appendout='';my $retry=0;print "LINE=".__LINE__."\n";
my $command_stripped_from_output=0;print "LINE=".__LINE__."\n";
my $test_stripped_output='';print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->autoflush(1);my $save='';print "LINE=".__LINE__."\n";
my $loop_count=0;my $loop_max=5;my $fetchflag=0;print "LINE=".__LINE__."\n";
my $test_for_no_output=0;print "LINE=".__LINE__."\n";
FETCH: while (1) {
my $output='';$nl='';$loop_count++;print "LINE=".__LINE__."\n";
my $tim=time()-$starttime;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "INFO: STARTTIME=$starttime and TIMENOW=",time(),
" and TIMEOUT=$cmtimeout and Diff=$tim\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
if ($select_timeout!=2 && $select_timeout==$tim) {
$self->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle},$tim);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
$cfh_error,'-2','__cleanup__')
if $cfh_error;print "LINE=".__LINE__."\n";
my $errhost='';print "LINE=".__LINE__."\n";
if ($hostlabel eq "__Master_${$}__") {
$errhost=$Net::FullAuto::FA_Core::local_hostname;print "LINE=".__LINE__."\n";
} 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";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->timeout($svtimeout);print "LINE=".__LINE__."\n";
if ($wantarray) {
die $lv_errmsg;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
} elsif (select
$ready=${${*{$self->{_cmd_handle}}}{net_telnet}}{fdmask},
'', '', $select_timeout) {
alarm($select_timeout+10);print "LINE=".__LINE__."\n";
sysread $self->{_cmd_handle},$output,
${${*{$self->{_cmd_handle}}}{net_telnet}}{blksize},0;print "LINE=".__LINE__."\n";
alarm(0);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$output=~s/[ ]*\015//g;print "LINE=".__LINE__."\n";
$output=~tr/\0-\11\13-\37\177-\377//d;print "LINE=".__LINE__."\n";
if (-1<index $output,'[A') {
$output=~s/^(.*2[>][&]1\s*)\[A\s*$/$1/s;print "LINE=".__LINE__."\n";
} elsif (-1<index $output,'7[r') {
$output=~s/7[[]r[[]999[;]999H[[]6n//s;print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
print "\nCMD RAW OUTPUT: ==>$output<== at Line ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
$first=1 if $first==0;print "LINE=".__LINE__."\n";
if (!$firstout) {
$firstout=1;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
next;print "LINE=".__LINE__."\n";
} else {
print "INFO: Setting \$firstout=1 and CONTINUING\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
}
}
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($appendout) {
$output="$appendout$output";print "LINE=".__LINE__."\n";
$appendout='';print "LINE=".__LINE__."\n";
$test_stripped_output=$output;print "LINE=".__LINE__."\n";
} else {
$test_stripped_output.=$output;print "LINE=".__LINE__."\n";
}
$test_stripped_output=~s/\s*//gs;print "LINE=".__LINE__."\n";
my $stripped_live_command=$live_command;print "LINE=".__LINE__."\n";
$stripped_live_command=~s/\s*//gs;print "LINE=".__LINE__."\n";
my $lslc=length $stripped_live_command;print "LINE=".__LINE__."\n";
my $ltso=length $test_stripped_output;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$command_stripped_from_output=1;print "LINE=".__LINE__."\n";
$output='';print "LINE=".__LINE__."\n";
$first=0;next;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
die 'logout' if $output=~/imed out/s
|| $output=~/logout$|closed\.$/mg;print "LINE=".__LINE__."\n";
if (-1<index $output,'[A[C[C') {
my $one='';my $two='';my $thr='';print "LINE=".__LINE__."\n";
my $qrx=qr/\s*stdout:.*|\s*_funkyPrompt_/;print "LINE=".__LINE__."\n";
my $grx=qr/(?:\[A(?:\[C)+(?:\[K1)*)/;print "LINE=".__LINE__."\n";
$output=~/^(.*&1)$grx(.*?)($qrx)*(\s*|'')$/s;print "LINE=".__LINE__."\n";
$one=$1 if defined $1;print "LINE=".__LINE__."\n";
$two=$2 if defined $2;print "LINE=".__LINE__."\n";
$thr=$3 if defined $3;print "LINE=".__LINE__."\n";
$output=$one.$two.$thr;print "LINE=".__LINE__."\n";
}
my $last_line='';print "LINE=".__LINE__."\n";
$output=~/^.*\n(.*)$/s;print "LINE=".__LINE__."\n";
$last_line=$1;print "LINE=".__LINE__."\n";
$last_line||='';print "LINE=".__LINE__."\n";
my $ptest=substr($output,(rindex $output,'|'),-1);print "LINE=".__LINE__."\n";
$ptest=~s/\s*//g;$ptest||='';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $llc=length $live_command;print "LINE=".__LINE__."\n";
my $oup=unpack("a$llc",$output);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (substr($oup,-1) eq 's') {
$llc--;print "LINE=".__LINE__."\n";
$output=unpack("x$llc a*",$output);print "LINE=".__LINE__."\n";
} else {
my $o=$output;my $c=0;print "LINE=".__LINE__."\n";
while (1) {
last if $c++==5;print "LINE=".__LINE__."\n";
$o=~s/^(.*?)\n(.*)$/$1$2/s;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ONNNNNNNNNN=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $op=unpack("a$llc",$o);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$op=unpack("x$llc a*",$o);print "LINE=".__LINE__."\n";
$output=$op;last;print "LINE=".__LINE__."\n";
}
}
}
} elsif (substr($oup,-1) eq 's') {
$llc--;print "LINE=".__LINE__."\n";
$output=unpack("x$llc a*",$output);print "LINE=".__LINE__."\n";
} else {
$output=unpack("x$llc a*",$output);print "LINE=".__LINE__."\n";
}
$first=0;$growoutput=$output;print "LINE=".__LINE__."\n";
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;print "LINE=".__LINE__."\n";
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,'*');print "LINE=".__LINE__."\n";
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
# Strip noise characters
$output=~s/^.*?(stdout:.*)$/$1/s;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "GRO_OUT_AFTER_NOISE_STRIP=$output\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*');print "LINE=".__LINE__."\n";
$growoutput=$output;print "LINE=".__LINE__."\n";
$output='';print "LINE=".__LINE__."\n";
$command_stripped_from_output=1;print "LINE=".__LINE__."\n";
}
$output='';print "LINE=".__LINE__."\n";
} elsif (($lslc<$ltso) &&
(-1<index $test_stripped_output,
$stripped_live_command)) {
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
$growoutput=$output;print "LINE=".__LINE__."\n";
$output='';print "LINE=".__LINE__."\n";
#$growoutput
# =~s/^.*$live_command(.*)$cmd_prompt$/$1/s;print "LINE=".__LINE__."\n";
$command_stripped_from_output=1;print "LINE=".__LINE__."\n";
}
$output='';print "LINE=".__LINE__."\n";
} elsif ((-1<index $output,'stdout:') &&
$output=~s/^\s*(stdout.*
\n$cmd_prompt)$/$1/sx) {
&display($output,$cmd_prompt,$save)
if $display;print "LINE=".__LINE__."\n";
$growoutput.=$output;$output='';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$first=0;print "LINE=".__LINE__."\n";
} else {
my $tsst=unpack("a$lslc",$test_stripped_output);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
&display($last_line,$cmd_prompt,$save)
if $display;print "LINE=".__LINE__."\n";
$first=0;$growoutput.=$last_line;print "LINE=".__LINE__."\n";
$growoutput=~s/^.*($cmd_prompt)$/$1/s;print "LINE=".__LINE__."\n";
$output='';print "LINE=".__LINE__."\n";
}
} 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,'*';print "LINE=".__LINE__."\n";
$first=0;next;print "LINE=".__LINE__."\n";
} 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,'*';print "LINE=".__LINE__."\n";
$first=0;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
$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 "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
#open(BK,">brianout.txt");print "LINE=".__LINE__."\n";
#print BK "$output";print "LINE=".__LINE__."\n";
#CORE::close BK;print "LINE=".__LINE__."\n";
#print "OPUT=$output<== and ",`od -a brianout.txt`,"\n";print "LINE=".__LINE__."\n";
#unlink "brianout.txt";print "LINE=".__LINE__."\n";
#open(BK,">brianout.txt");print "LINE=".__LINE__."\n";
#print BK "$lv_cmd";print "LINE=".__LINE__."\n";
#CORE::close BK;print "LINE=".__LINE__."\n";
#print "LV_CMD=$lv_cmd<== and ",`od -a brianout.txt`,"\n";print "LINE=".__LINE__."\n";
#unlink "brianout.txt";print "LINE=".__LINE__."\n";
#print "EXAMINERR=>OPUT=$output<= and LV_CMD=$lv_cmd<=\n";print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
#print "OUTPUTNOWWWWWWWWWWW=$output<== and STRIPPED=$command_stripped_from_output\n";print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
my $lcp=length $cmd_prompt;print "LINE=".__LINE__."\n";
$lcp+=18;print "LINE=".__LINE__."\n";
unless ($growoutput) {
print $Net::FullAuto::FA_Core::MRLOG "NO GROWOUTPUTTTTTTTTTTTTT\n" if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*');print "LINE=".__LINE__."\n";
if ($output && unpack('a1',$output) eq '[') {
if ($output=~/^\[A(\[C)+\[K1\s*/s) {
next FETCH;print "LINE=".__LINE__."\n";
}
}
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,'*';print "LINE=".__LINE__."\n";
my $tou=$output;print "LINE=".__LINE__."\n";
$tou=~s/^\s?$cmd_prompt\s*//;print "LINE=".__LINE__."\n";
my $ltu=length $tou;print "LINE=".__LINE__."\n";
$test_stripped_output=$tou;print "LINE=".__LINE__."\n";
$test_stripped_output=~s/\s*//gs;print "LINE=".__LINE__."\n";
my $stripped_live_command=$live_command;print "LINE=".__LINE__."\n";
$stripped_live_command=~s/\s*//gs;print "LINE=".__LINE__."\n";
my $lslc=length $stripped_live_command;print "LINE=".__LINE__."\n";
my $ltso=length $test_stripped_output;print "LINE=".__LINE__."\n";
if (($lslc<$ltso) &&
(unpack("a$lslc",$test_stripped_output) eq
$stripped_live_command)) {
my $llc=length $live_command;print "LINE=".__LINE__."\n";
$growoutput=unpack("x$llc a*",$tou);print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "KKKKKKKSSSSSSSSSSSSKKKKKKKK\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$first=0;$output='';$fulloutput='';print "LINE=".__LINE__."\n";
$command_stripped_from_output=1;print "LINE=".__LINE__."\n";
if ($growoutput=~/$cmd_prompt$/s) {
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;print "LINE=".__LINE__."\n";
chomp($growoutput);print "LINE=".__LINE__."\n";
$growoutput.="\n".$cmd_prompt;print "LINE=".__LINE__."\n";
$lastline=$cmd_prompt;print "LINE=".__LINE__."\n";
} else {
$growoutput='';print "LINE=".__LINE__."\n";
next FETCH;print "LINE=".__LINE__."\n";
}
} 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,'*';print "LINE=".__LINE__."\n";
$first=-1;print "LINE=".__LINE__."\n";
$fulloutput='';print "LINE=".__LINE__."\n";
$command_stripped_from_output=0;print "LINE=".__LINE__."\n";
$appendout=$tou;print "LINE=".__LINE__."\n";
$fetchflag=1;print "LINE=".__LINE__."\n";
next FETCH;print "LINE=".__LINE__."\n";
} last FETCH;print "LINE=".__LINE__."\n";
} elsif (-1<index $output,'Connection reset by peer') {
$fullerror.=$output;print "LINE=".__LINE__."\n";
last FETCH;print "LINE=".__LINE__."\n";
} elsif ($output=~/^\s?$/) {
next FETCH;print "LINE=".__LINE__."\n";
} elsif ($output=~/^(stdout: .*)$cmd_prompt$/) {
$growoutput=$1."\n".$cmd_prompt;print "LINE=".__LINE__."\n";
$lastline=$cmd_prompt;print "LINE=".__LINE__."\n";
$output='';$fulloutput='';print "LINE=".__LINE__."\n";
} elsif ($fetchflag) {
print $Net::FullAuto::FA_Core::MRLOG "FETCHFLAGGGGGGGGGG=$fetchflag\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$growoutput.=$output;print "LINE=".__LINE__."\n";
next FETCH
}
} elsif (($output=~/^stdout: (?!\/')/) &&
($growoutput=~/ 2\>&1\s?$/)) {
$growoutput=$output;print "LINE=".__LINE__."\n";
next FETCH if $output!~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
$output='';$fulloutput='';print "LINE=".__LINE__."\n";
} elsif ($growoutput && $output eq $cmd_prompt) {
chomp $growoutput;print "LINE=".__LINE__."\n";
$growoutput.="\n".$cmd_prompt;print "LINE=".__LINE__."\n";
$lastline=$cmd_prompt;print "LINE=".__LINE__."\n";
$output='';$fulloutput='';print "LINE=".__LINE__."\n";
} elsif ($output=~/$cmd_prompt$/s) {
$growoutput.=$output;print "LINE=".__LINE__."\n";
$lastline=$cmd_prompt;print "LINE=".__LINE__."\n";
$output='';$fulloutput='';print "LINE=".__LINE__."\n";
} elsif (unpack("a$lcp",$output) eq
$cmd_prompt.'cmd /Q /C "set /A ') {
$lastline=$cmd_prompt;print "LINE=".__LINE__."\n";
$output='';$fulloutput='';print "LINE=".__LINE__."\n";
}
} elsif ($output eq 'Connection closed') {
if ($wantarray) {
return 0,$output;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($output)
}
} elsif ($output eq '>') {
if (substr($growoutput,-1) eq '2') {
$growoutput.=$output;print "LINE=".__LINE__."\n";
$first=-1;print "LINE=".__LINE__."\n";
next FETCH;print "LINE=".__LINE__."\n";
}
my $die="The Command:\n\n $command"
."\n\nHas a Syntax Error. The Command "
."Shell\n Entered Interacive Mode '>'";print "LINE=".__LINE__."\n";
if ($wantarray) {
return 0,$die;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($die)
}
}
$output=~s/^[ |\t]+(stdout:.*)$/$1/m if !$fullerror;print "LINE=".__LINE__."\n";
&display($output,$cmd_prompt,$save)
if $display;print "LINE=".__LINE__."\n";
$growoutput.=$output;print "LINE=".__LINE__."\n";
#if ($Net::FullAuto::FA_Core::debug) {
#open(BK,">brianout.txt");print "LINE=".__LINE__."\n";
#print BK "$growoutput";print "LINE=".__LINE__."\n";
#CORE::close BK;print "LINE=".__LINE__."\n";
#print "OD_GROWOUTPUT=$growoutput<== and ",`od -a brianout.txt`,"\n";print "LINE=".__LINE__."\n";
#unlink "brianout.txt";print "LINE=".__LINE__."\n";
#}
$test_out="\$growoutput";print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
}
if (15<length $growoutput &&
unpack('a16',$growoutput) eq '?Invalid command') {
$self->{_cmd_handle}->timeout($svtimeout);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error(
"?Invalid Command ftp> -> $live_command");print "LINE=".__LINE__."\n";
} elsif (-1<index lc($growoutput),'killed by signal 15') {
die 'Connection closed';print "LINE=".__LINE__."\n";
} elsif ((-1==index $growoutput,'stdout:') &&
(-1<index $growoutput,' sync_with_child: ')) {
&Net::FullAuto::FA_Core::handle_error(
$growoutput,'__cleanup__');print "LINE=".__LINE__."\n";
} elsif (1<($growoutput=~tr/\n//) ||
$growoutput=~/($cmd_prompt)$/s) {
my $oneline=$1;$oneline||=0;print "LINE=".__LINE__."\n";
($lastline=$growoutput)=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
print "NOWLASTLINE=$lastline<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "NOWLASTLINE=$lastline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$first=0;print "LINE=".__LINE__."\n";
$growoutput='';print "LINE=".__LINE__."\n";
} else {
if ($growoutput=~/$cmd_prompt/s) {
print "GROWOUTPUT2=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if ($growoutput=~/stdout: PS1=/m) {
($lastline=$growoutput)=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
} elsif ($growoutput=~s/^\n*$cmd_prompt\n*//s) {
my $test_stripped_output=$growoutput;print "LINE=".__LINE__."\n";
my $stripped_live_command=$live_command;print "LINE=".__LINE__."\n";
$stripped_live_command=~s/\s*//gs;print "LINE=".__LINE__."\n";
my $testgrow=$test_stripped_output;print "LINE=".__LINE__."\n";
$testgrow=~s/^(.*?2>&1\n?)(.*)$/$1/s;print "LINE=".__LINE__."\n";
my $thisout=$2;print "LINE=".__LINE__."\n";
$testgrow=~s/\s*//gs;print "LINE=".__LINE__."\n";
if ($testgrow eq $stripped_live_command) {
$growoutput=$thisout;print "LINE=".__LINE__."\n";
}
my $lvc=$live_command;print "LINE=".__LINE__."\n";
last FETCH if !$growoutput && ($allow_no_output
|| $lvc=~/^[(]*c[dp]\s/ || $lvc=~/^[(]*ls\s/
|| $lvc=~/^[(]*mkdir\s/ || $lvc=~/^[(]*mv\s/
|| $lvc=~/^[(]*rm\s/ || $lvc=~/[\/]ls\s/
|| $lvc=~/[\/]rm\s/ || $lvc=~/[\/]mkdir\s/
|| $lvc=~/[\/]cp\s/ || $lvc=~/^[(]*touch\s/ );print "LINE=".__LINE__."\n";
next FETCH if !$growoutput;print "LINE=".__LINE__."\n";
if (-1<index $growoutput,'stdout: /') {
my $stub=substr($growoutput,0,
(index $growoutput,'stdout: /'));print "LINE=".__LINE__."\n";
if (substr($live_command,0,(length $stub))
eq $stub) {
my $go=$growoutput;print "LINE=".__LINE__."\n";
$growoutput=substr($go,(length $stub));print "LINE=".__LINE__."\n";
}
} elsif ((-1<index $live_command, $growoutput) &&
(substr($live_command,0,
(length $growoutput)) eq $growoutput)) {
$growoutput='';next FETCH;print "LINE=".__LINE__."\n";
}
if ($growoutput) {
if ($growoutput=~/^\s*$cmd_prompt$/s) {
$growoutput='';print "LINE=".__LINE__."\n";
last FETCH;
} elsif ($growoutput!~/$cmd_prompt$/) {
next FETCH;print "LINE=".__LINE__."\n";
}
}
print "CLEANEDGROWOUT=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} elsif ((-1<index $growoutput,$live_command) &&
(-1<index $growoutput,'[C[C[K1')) {
$growoutput=~s/\[A(\[C)+\[K1//s;print "LINE=".__LINE__."\n";
}
} elsif (!$lastline) {
my $tmp_grow=$growoutput;print "LINE=".__LINE__."\n";
chomp $tmp_grow;print "LINE=".__LINE__."\n";
($lastline=$tmp_grow)=~s/^.*\n(.*)$/$1/s;print "LINE=".__LINE__."\n";
$lastline.="\n";print "LINE=".__LINE__."\n";
}
my $l=length $live_command;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$first=0;$growoutput='';print "LINE=".__LINE__."\n";
$output='';print "LINE=".__LINE__."\n";
} elsif ($oneline) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEENb\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$first=0;print "LINE=".__LINE__."\n";
}
} else {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEENd\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
$growoutput=~s/^(.*?)\012//s;print "LINE=".__LINE__."\n";
my $f_line=$1;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$first=0;print "LINE=".__LINE__."\n";
}
}
} 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,'*';print "LINE=".__LINE__."\n";
my $test_stripped_output=$growoutput;print "LINE=".__LINE__."\n";
$test_stripped_output=~s/\s*//gs;print "LINE=".__LINE__."\n";
my $stripped_live_command=$live_command;print "LINE=".__LINE__."\n";
$stripped_live_command=~s/\s*//gs;print "LINE=".__LINE__."\n";
my $lslc=length $stripped_live_command;print "LINE=".__LINE__."\n";
my $ltso=length $test_stripped_output;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "TEEN2=$stripped_live_command<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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,'*
';print "LINE=".__LINE__."\n";
my $llc=length $live_command;print "LINE=".__LINE__."\n";
my $oup=unpack("a$llc",$output);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
#my $o=$output;my $c=0;print "LINE=".__LINE__."\n";
my $o=$growoutput;my $c=0;print "LINE=".__LINE__."\n";
while (1) {
last if $c++==5;print "LINE=".__LINE__."\n";
$o=~s/^(.*?)\n(.*)$/$1$2/s;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ONNNNNTTTT=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $op=unpack("a$llc",$o);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$op=unpack("x$llc a*",$o);print "LINE=".__LINE__."\n";
$output=$op;last;print "LINE=".__LINE__."\n";
} elsif (substr($op,-1) eq 's') {
$llc--;print "LINE=".__LINE__."\n";
$op=unpack("x$llc a*",$o);print "LINE=".__LINE__."\n";
$output=$op;last;print "LINE=".__LINE__."\n";
}
}
} else {
$output=unpack("x$llc a*",$output);print "LINE=".__LINE__."\n";
}
$first=0;$growoutput=$output;print "LINE=".__LINE__."\n";
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;print "LINE=".__LINE__."\n";
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,'*');print "LINE=".__LINE__."\n";
$command_stripped_from_output=1;print "LINE=".__LINE__."\n";
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
$growoutput=$output;print "LINE=".__LINE__."\n";
$lastline=$cmd_prompt;print "LINE=".__LINE__."\n";
} else {
next FETCH;
}
#} elsif ($growoutput=~/^stdout:\s*stdout:/s) {
} elsif ($growoutput=~/^stdout:.*stdout:/s) {
$command_stripped_from_output=1;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
}
}
print "DONE TRIMMING GROWOUTPUT=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
#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,'*';print "LINE=".__LINE__."\n";
if ($growoutput) {
if ($wantarray) {
my @strings=split /^/, $growoutput;print "LINE=".__LINE__."\n";
my $str_cnt=$#strings;print "LINE=".__LINE__."\n";
#print "CLEARING FULLOUTPUT\n";<STDIN>;print "LINE=".__LINE__."\n";
$fulloutput='';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if ($line ne $lastline || 0<$str_cnt) {
$str_cnt--;print "LINE=".__LINE__."\n";
if ($line=~s/^stdout: ?//) {
$fulloutput.=$line;print "LINE=".__LINE__."\n";
$errflag='';print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
#print $Net::FullAuto::FA_Core::MRLOG "DOIN FULLERROR1==>$line<==\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (!$line) {
my $lastDB43=0;my $testline='';print "LINE=".__LINE__."\n";
DB43: while (1) {
print $Net::FullAuto::FA_Core::MRLOG "WE ARE INSIDE DB43\n";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->autoflush(1);print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print("echo FAECHO");print "LINE=".__LINE__."\n";
eval {
while (my $line=$self->{_cmd_handle}->get) {
$line=~tr/\0-\11\13-\37\177-\377//d;print "LINE=".__LINE__."\n";
($testline=$line)=~s/\s//g;print "LINE=".__LINE__."\n";
print "DB43output=$testline<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DB43output=$testline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($testline=~/^$cmd_prompt$/) {
$lastDB43=1;last
}
if ($testline=~s/$cmd_prompt$//s) {
$line=~s/$cmd_prompt$//s;print "LINE=".__LINE__."\n";
$output.=$line;last;print "LINE=".__LINE__."\n";
} else { $output.=$line }
}
#print "DONEWITHDB43WILE and OUTPUTNOW=$output\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DONEWITHDB43WHILE and OUTPUTNOW=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
}; $self->{_cmd_handle}->autoflush(0);print "LINE=".__LINE__."\n";
last if $lastDB43;print "LINE=".__LINE__."\n";
if ($@) {
if (-1<index $@,'read timed-out') {
next;print "LINE=".__LINE__."\n";
} else { die "$@ $!" }
}
}
my $tst_out=$output;print "LINE=".__LINE__."\n";
$tst_out=~s/\s*//gs;print "LINE=".__LINE__."\n";
print "TST_OUTTTTT=$tst_out<==\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
}
if ($fullerror && !$errflag) {
$fullerror.="\n";print "LINE=".__LINE__."\n";
} $errflag=1;print "LINE=".__LINE__."\n";
$fullerror.=$line;print "LINE=".__LINE__."\n";
&display($line,$cmd_prompt,$save)
if $display;print "LINE=".__LINE__."\n";
} elsif ($fulloutput || $line!~/^\s*$/s) {
$fulloutput.=$line;print "LINE=".__LINE__."\n";
&display($line,$cmd_prompt,$save)
if $display;print "LINE=".__LINE__."\n";
$errflag='';print "LINE=".__LINE__."\n";
}
}
}
} elsif ($fulloutput || $line!~/^\s*$/s) {
print "HOW OFTEN IS FULL GETTINNG IT?=$loop_count\n";print "LINE=".__LINE__."\n";
$fulloutput.=$growoutput;print "LINE=".__LINE__."\n";
}
}
print "GROW_ADDED_TO_FULL=$growoutput<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
if ($growoutput) {
if ($log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*') {
print $Net::FullAuto::FA_Core::MRLOG $growoutput if $loop_count<$loop_max;print "LINE=".__LINE__."\n";
}
#&display($output,$cmd_prompt,$save) if $display;print "LINE=".__LINE__."\n";
}
if ($loop_count<$loop_max) {
my $lcntt=0;my $newline='';print "LINE=".__LINE__."\n";
foreach my $line (reverse split /^/, $fulloutput) {
$newline=$line.$newline;print "LINE=".__LINE__."\n";
last if $lcntt++==5;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
}
if (!$lastline) {
if ($retry++<3) {
my $forcedoutput='';print "LINE=".__LINE__."\n";
DB18: while (1) {
if ($retry<2) {
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
} else {
print "THIRTEEN003\n";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
}
my $oline='';print "LINE=".__LINE__."\n";
while (my $line=$self->{_cmd_handle}->get) {
$oline=$line;print "LINE=".__LINE__."\n";
$line=~s/\s//g;print "LINE=".__LINE__."\n";
last DB18 if $line=~/^$cmd_prompt$/;print "LINE=".__LINE__."\n";
$forcedoutput.=$oline;print "LINE=".__LINE__."\n";
last if $line=~/$cmd_prompt$/s;print "LINE=".__LINE__."\n";
}
} $forcedoutput||='';print "LINE=".__LINE__."\n";
$forcedoutput=~s/^$cmd_prompt$//gm;print "LINE=".__LINE__."\n";
foreach my $line (split /^/, $forcedoutput) {
if ($line=~s/^stdout: ?// &&
($fulloutput || $line!~/^\s*$/s)) {
$fulloutput.=$line;print "LINE=".__LINE__."\n";
&display($line,$cmd_prompt,$save)
if $display;print "LINE=".__LINE__."\n";
$errflag='';print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DOIN FULLERROR2222==>$line<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($fullerror && !$errflag) {
$fullerror.="\n";print "LINE=".__LINE__."\n";
} $errflag=1;print "LINE=".__LINE__."\n";
$fullerror.=$line;print "LINE=".__LINE__."\n";
if ($fullerror) {
if ($log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*') {
print $Net::FullAuto::FA_Core::MRLOG $fullerror;print "LINE=".__LINE__."\n";
}
&display($line,$cmd_prompt,$save)
if $display;print "LINE=".__LINE__."\n";
}
}
}
if ($ms_cmd) {
$stdout=$fullerror;print "LINE=".__LINE__."\n";
} else {
$stdout=$fulloutput;print "LINE=".__LINE__."\n";
$stderr=$fullerror;print "LINE=".__LINE__."\n";
}
chomp $stdout if $stdout;print "LINE=".__LINE__."\n";
chomp $stderr if $stderr;print "LINE=".__LINE__."\n";
last FETCH;print "LINE=".__LINE__."\n";
}
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 "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG $warng
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq
'notify_on_error') {
my $subwarn="WARNING! Command Appears "
."to be Hanging or Stopped";print "LINE=".__LINE__."\n";
my %mail=(
'Body' => "$warng",
'Subject' => "$subwarn"
);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::send_email(\%mail);print "LINE=".__LINE__."\n";
}
if ($ms_cmd) {
$stdout=$fullerror;print "LINE=".__LINE__."\n";
} else {
$stdout=$fulloutput;print "LINE=".__LINE__."\n";
$stderr=$fullerror;print "LINE=".__LINE__."\n";
}
chomp $stdout if $stdout;print "LINE=".__LINE__."\n";
chomp $stderr if $stderr;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
$stdout=$fulloutput;print "LINE=".__LINE__."\n";
$stderr=$fullerror;print "LINE=".__LINE__."\n";
chomp $stdout if $stdout;print "LINE=".__LINE__."\n";
chomp $stderr if $stderr;print "LINE=".__LINE__."\n";
last;print "LINE=".__LINE__."\n";
} elsif ($lastline=~/^\s*$/) {
$growoutput.=$lastline;print "LINE=".__LINE__."\n";
} elsif (!$command_stripped_from_output) {
$growoutput=$lastline;print "LINE=".__LINE__."\n";
}
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;print "LINE=".__LINE__."\n";
$starttime=0;$select_timeout=0;print "LINE=".__LINE__."\n";
} else {
$starttime=time();$select_timeout=$cmtimeout;print "LINE=".__LINE__."\n";
$restart_attempt=1;print "LINE=".__LINE__."\n";
}
$command_stripped_from_output=1;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "PAST THE ALARM4\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
} elsif ($starttime && (($cmtimeout<time()-$starttime)
|| ($select_timeout<time()-$starttime))) {
#print $Net::FullAuto::FA_Core::MRLOG "ELSFI AT THE BOTTOM==>$growoutput<==\n";print "LINE=".__LINE__."\n";
if (!$restart_attempt) {
print "FOURTEEN003\n";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print("\003");print "LINE=".__LINE__."\n";
my $cfh_ignore='';my $cfh_error='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->timeout($svtimeout);print "LINE=".__LINE__."\n";
if ($wantarray) {
die $lv_errmsg;print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
} else {
$restart_attempt=0;print "LINE=".__LINE__."\n";
$starttime=time();$select_timeout=$cmtimeout;print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->print;print "LINE=".__LINE__."\n";
}
} elsif (!$starttime) {
$starttime=time();$select_timeout=$cmtimeout;print "LINE=".__LINE__."\n";
$restart_attempt=1;print "LINE=".__LINE__."\n";
}
}
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEE\n";print "LINE=".__LINE__."\n";
$stderr=$lastline if $lastline=~/Connection to.*closed/s;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($stderr!~s/^\s*$//s && $stderr ne '_funkyPrompt_') {
chomp($stderr);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if !$wantarray;print "LINE=".__LINE__."\n";
}
$stderr='' if $stderr eq '_funkyPrompt_';print "LINE=".__LINE__."\n";
if (-1<index $stderr,'_funkyPrompt_') {
my $test_stderr=$stderr;print "LINE=".__LINE__."\n";
$test_stderr=~s/_funkyPrompt_//g;print "LINE=".__LINE__."\n";
$test_stderr=~s/^\s*$//;print "LINE=".__LINE__."\n";
$stderr='' unless $test_stderr;print "LINE=".__LINE__."\n";
}
}
};print "LINE=".__LINE__."\n";
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEXXXXXXXXXXX\n";print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->autoflush(0)
if defined fileno $self->{_cmd_handle};print "LINE=".__LINE__."\n";
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEUUUUUUUUUUU\n";print "LINE=".__LINE__."\n";
my $eval_error='';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$eval_error=$@;undef $@;print "LINE=".__LINE__."\n";
}
if ($ftp) {
$self->{_ftp_handle}->timeout($svtimeout);print "LINE=".__LINE__."\n";
} else {
$self->{_cmd_handle}->timeout($svtimeout);print "LINE=".__LINE__."\n";
}
$eval_error=$stderr if $stderr && !$eval_error;
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEOOOOOOOOOOOOO\n";print "LINE=".__LINE__."\n";
if ($eval_error) {
chomp($eval_error=~tr/\0-\11\13-\37\177-\377//d);print "LINE=".__LINE__."\n";
$eval_error=~s/^\s+//;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock($sem) if $sem;print "LINE=".__LINE__."\n";
if ((-1<index $command,"kill ") &&
(-1<index $eval_error,"eof")) {
my $prc=substr($command,-3);print "LINE=".__LINE__."\n";
if ($wantarray) {
return "process \#$prc killed","";print "LINE=".__LINE__."\n";
} else { return "process \#$prc killed" }
} $login_retry++;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $sav_self=$self->{_cmd_handle};print "LINE=".__LINE__."\n";
my $curdir=$self->{_work_dirs}->{_cwd}
|| $self->{_work_dirs}->{_cwd_mswin};print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "CURDIR=$curdir\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($self->{_cmd_pid},$kill_arg) if
&Net::FullAuto::FA_Core::testpid($self->{_cmd_pid});print "LINE=".__LINE__."\n";
$self->{_cmd_handle}->close;print "LINE=".__LINE__."\n";
if (!exists $same_host_as_Master{$self->{_hostlabel}->[0]}) {
($self,$stderr)=&Net::FullAuto::FA_Core::connect_host(
$self->{_hostlabel}->[0],$cmtimeout);print "LINE=".__LINE__."\n";
} else {
($self,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',
$self->{_connect});print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
$self->cwd($curdir);print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
delete $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};print "LINE=".__LINE__."\n";
substr($type,0,3)='cmd';print "LINE=".__LINE__."\n";
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;print "LINE=".__LINE__."\n";
last CH;print "LINE=".__LINE__."\n";
}
}
}
} next if $self;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $save_cwd='';print "LINE=".__LINE__."\n";
if (exists $self->{_work_dirs}->{_cwd_mswin}
&& $self->{_work_dirs}->{_cwd_mswin}=~/^\\\\/) {
$save_cwd=$self->{_work_dirs}->{_tmp}||'';print "LINE=".__LINE__."\n";
} else {
$save_cwd=$self->{_work_dirs}->{_cwd}||'';print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
($self->{_cmd_handle},$eval_error)=
&login_retry($self->{_cmd_handle},
$self->{_connect},
$self->{_cmd_type},$eval_error);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
($output,$stderr)=$self->cwd($save_cwd);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$eval_error;print "LINE=".__LINE__."\n";
} 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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
$stdout||='';print "LINE=".__LINE__."\n";
return $stdout,$eval_error;print "LINE=".__LINE__."\n";
} else { &Net::FullAuto::FA_Core::handle_error($eval_error) }
}
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEMMMMMMMMMM\n";print "LINE=".__LINE__."\n";
pop @FA_Core::pid_ts if $pid_ts;print "LINE=".__LINE__."\n";
$stdout||='';$stderr||='';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock($sem) if $sem;print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEENNNNNNNNNN\n";print "LINE=".__LINE__."\n";
if ($wantarray) {
return $stdout,$stderr;print "LINE=".__LINE__."\n";
} else { return $stdout }
}
}
sub display
{
#print "DISPLAY_CALLER=",caller,"\n";print "LINE=".__LINE__."\n";
my $line=$_[0];print "LINE=".__LINE__."\n";
my $cmd_prompt=$_[1];print "LINE=".__LINE__."\n";
my $save=$_[2];print "LINE=".__LINE__."\n";
######## CHANGED LINE BELOW AND ADDED THE ? AFTER stdout: ? 080107
$line=~s/^stdout: ?//mg;print "LINE=".__LINE__."\n";
if (length $line<length $cmd_prompt) {
if (-1<index $cmd_prompt,substr($line,(rindex $line,'_'))) {
$save.=$line;print "LINE=".__LINE__."\n";
return $save;print "LINE=".__LINE__."\n";
} else {
$save='';print "LINE=".__LINE__."\n";
print $line;print "LINE=".__LINE__."\n";
return $save;print "LINE=".__LINE__."\n";
}
} elsif ($line=~s/\n*$cmd_prompt//gs) {
$save='';print "LINE=".__LINE__."\n";
print $line;print "LINE=".__LINE__."\n";
return $save;print "LINE=".__LINE__."\n";
} elsif (-1<index $cmd_prompt,substr($line,(rindex $line,'_'))) {
$save.=$line;print "LINE=".__LINE__."\n";
return $save;
} else {
$save='';print "LINE=".__LINE__."\n";
print $line;print "LINE=".__LINE__."\n";
return $save;print "LINE=".__LINE__."\n";
}
}
sub login_retry
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Rem_Command::login_retry() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];my $_connect=$_[1];print "LINE=".__LINE__."\n";
my $cmd_type=$_[2];my $error=$_[3];print "LINE=".__LINE__."\n";
my $sid='';my $hostlabel='';print "LINE=".__LINE__."\n";
if ($self eq $localhost->{_cmd_handle}) {
$hostlabel=$localhost->{_hostlabel}->[0];print "LINE=".__LINE__."\n";
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});print "LINE=".__LINE__."\n";
$sid=($su_id)?$su_id:$login_id;print "LINE=".__LINE__."\n";
} 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;print "LINE=".__LINE__."\n";
last LR;print "LINE=".__LINE__."\n";
}
}
}
}
}
#print "ONEEE=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"},"\n";print "LINE=".__LINE__."\n";
#print "TWOOO=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"}->{_work_dirs},"\n";print "LINE=".__LINE__."\n";
#print "LOGINRETRYHOSTLABEL=$hostlabel<== and SID=$sid<== and CWD=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"}->{_work_dirs}->{_cwd},"\n";print "LINE=".__LINE__."\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,'*';print "LINE=".__LINE__."\n";
my $new_handle='';my ($stdout,$stderr)=('','');print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $handleid="$self";print "LINE=".__LINE__."\n";
$self->autoflush(1);print "LINE=".__LINE__."\n";
$self->close;print "LINE=".__LINE__."\n";
my $kill_arg=($^O eq 'cygwin')?'f':9;print "LINE=".__LINE__."\n";
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";print "LINE=".__LINE__."\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]);print "LINE=".__LINE__."\n";
($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 "LINE=".__LINE__."\n";
print "THISKILL1=${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[1]\n";print "LINE=".__LINE__."\n";
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};print "LINE=".__LINE__."\n";
last KFH;print "LINE=".__LINE__."\n";
}
}
}
}
($new_handle,$stderr)=&Net::FullAuto::FA_Core::connect_cmdX($hostlabel,$timeout);print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
} $self->close;print "LINE=".__LINE__."\n";
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};print "LINE=".__LINE__."\n";
last RL;print "LINE=".__LINE__."\n";
}
}
}
}
#if (-1<index $new_handle->{_cmd_handle},'HASH') {
# return $new_handle->{_cmd_handle}->{_cmd_handle},'';print "LINE=".__LINE__."\n";
#} else { return $new_handle->{_cmd_handle},'' }
return $new_handle->{_cmd_handle},'';print "LINE=".__LINE__."\n";
} elsif ($^O ne 'cygwin' && $su_id) {
$self->print;print "LINE=".__LINE__."\n";
my $id='';print "LINE=".__LINE__."\n";
($id,$stderr)=&Net::FullAuto::FA_Core::unix_id($self,$su_id,
$hostlabel,$error);print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
print "GOT NEW UNIX ID=$id and STDERR=$stderr and SU_ID=$su_id\n";print "LINE=".__LINE__."\n";
return '',$error if $stderr;print "LINE=".__LINE__."\n";
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='';print "LINE=".__LINE__."\n";
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self);print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;print "LINE=".__LINE__."\n";
my ($ignore,$su_err)=
&Net::FullAuto::FA_Core::su($self,$hostlabel,$login_id,
$su_id,$hostname,$ip,$use,$uname,$_connect,$cmd_type,
[],$error);print "LINE=".__LINE__."\n";
print "SU_ERR=$su_err\n" if $su_err;print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;print "LINE=".__LINE__."\n";
return $self,'';print "LINE=".__LINE__."\n";
}
} else { return $self,$error }
}
sub cwd
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Rem_Command::cwd() (((((((CALLER))))))):\n ",(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
return &File_Transfer::cwd(@_);print "LINE=".__LINE__."\n";
}
package Bad_Handle;print "LINE=".__LINE__."\n";
sub new {
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $class = ref($_[0]) || $_[0];print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $stderr=$_[2];print "LINE=".__LINE__."\n";
my $self = { };print "LINE=".__LINE__."\n";
my $_connect='';print "LINE=".__LINE__."\n";
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);print "LINE=".__LINE__."\n";
my $host=($use eq 'ip') ? $ip : $hostname;print "LINE=".__LINE__."\n";
$self->{_hostlabel}=[ $hostlabel,'' ];print "LINE=".__LINE__."\n";
$self->{_hostname}=$hostname;print "LINE=".__LINE__."\n";
$self->{_ip}=$ip;print "LINE=".__LINE__."\n";
$self->{_uname}=$uname;print "LINE=".__LINE__."\n";
$self->{_luname}=$^O;print "LINE=".__LINE__."\n";
$self->{_cmd_handle}='';print "LINE=".__LINE__."\n";
$self->{_cmd_type}='';print "LINE=".__LINE__."\n";
$self->{_stderr}=$stderr;print "LINE=".__LINE__."\n";
$self->{_ping}=$ping;print "LINE=".__LINE__."\n";
bless($self,$class);print "LINE=".__LINE__."\n";
if (wantarray) {
return $self,'';print "LINE=".__LINE__."\n";
} else {
return $self;print "LINE=".__LINE__."\n";
}
}
sub close {
return 0,'';print "LINE=".__LINE__."\n";
}
sub cmd
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub cwd
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub repl
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub select_dir
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::select_dir() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub get_vlabel
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::get_vlabel() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub ftp
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::ftp() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub get
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::get() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub put
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::put() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub lcd
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::lcd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
sub ls
{
my $self=$_[0];print "LINE=".__LINE__."\n";
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "\nINFO: Bad_Handle::ls() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if (wantarray) {
return '',$self->{_stderr};print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});print "LINE=".__LINE__."\n";
}
}
package Net::FullAuto::MemoryHandle;print "LINE=".__LINE__."\n";
use strict;print "LINE=".__LINE__."\n";
sub TIEHANDLE {
my $class = shift;print "LINE=".__LINE__."\n";
bless [], $class;print "LINE=".__LINE__."\n";
}
sub PRINT {
my $self = shift;print "LINE=".__LINE__."\n";
push @$self, join '', @_;print "LINE=".__LINE__."\n";
}
sub PRINTF {
my $self = shift;print "LINE=".__LINE__."\n";
my $fmt = shift;print "LINE=".__LINE__."\n";
push @$self, sprintf $fmt, @_;print "LINE=".__LINE__."\n";
}
sub READLINE {
my $self = shift;print "LINE=".__LINE__."\n";
shift @$self;print "LINE=".__LINE__."\n";
}
package Net::FullAuto::FA_DB;print "LINE=".__LINE__."\n";
use strict;print "LINE=".__LINE__."\n";
use BerkeleyDB;print "LINE=".__LINE__."\n";
sub new
{
my $class=shift;print "LINE=".__LINE__."\n";
my $self={};print "LINE=".__LINE__."\n";
$self->{_dbfile}=shift;print "LINE=".__LINE__."\n";
$self->{_dbfile}=~s/\.db$//;print "LINE=".__LINE__."\n";
$self->{_host_queried}={};print "LINE=".__LINE__."\n";
$self->{_line_queried}={};print "LINE=".__LINE__."\n";
bless($self,$class);print "LINE=".__LINE__."\n";
}
sub add
{
print "ADDCALLER=",caller,"\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ADDCALLER=".(caller)."\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
my $tie_err="can't open tie to $self->{_dbfile}.db";print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $line=$_[2];print "LINE=".__LINE__."\n";
if (!$line) {
if (wantarray) {
return '','ERROR - no entry specified';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"FullAutoDB: ERROR - no entry specified\n");print "LINE=".__LINE__."\n";
}
}
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;print "LINE=".__LINE__."\n";
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;print "LINE=".__LINE__."\n";
$line=~s/^.*\s+($rx1|$rx2)$/$1/;print "LINE=".__LINE__."\n";
$line=~/^(\d+)\s+(\w\w\w\s+\d+\s+\S+).*$/;print "LINE=".__LINE__."\n";
my $size=$1;my $timestamp=$2;print "LINE=".__LINE__."\n";
my $mt='';my $hr=0;my $dy=0;my $mn=0;my $fileyr=0;print "LINE=".__LINE__."\n";
eval {
($mn,$dy,$mt)=split /\s+/, $timestamp;print "LINE=".__LINE__."\n";
if (-1<index $mt,':') {
($hr,$mt)=split ':', $mt;print "LINE=".__LINE__."\n";
$fileyr=(localtime)[5];print "LINE=".__LINE__."\n";
} else {
$fileyr=$mt;$mt=0;print "LINE=".__LINE__."\n";
}
$timestamp=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$Net::FullAuto::FA_Core::month{$mn}-1,$fileyr);print "LINE=".__LINE__."\n";
};print "LINE=".__LINE__."\n";
if ($@) {
&Net::FullAuto::FA_Core::handle_error(
"$@ - LSLINE=$line<- AND TIMESTAMP=$timestamp<- AND MN=$mn<-");print "LINE=".__LINE__."\n";
}
my $ipc_key="$timestamp$size";print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::release_fa_lock($ipc_key);print "LINE=".__LINE__."\n";
$line="${hostlabel}|%|$line";print "LINE=".__LINE__."\n";
${$self->{_host_queried}}{"$hostlabel"}='-';print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
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");print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
print "ADDING LINE=$line<==\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "ADDING LINE=$line<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $status=$bdb->db_put($line,time);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
return 1,'';print "LINE=".__LINE__."\n";
}
sub query
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "FA_DB::query() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $self=$_[0];print "LINE=".__LINE__."\n";
my $tie_err="can't open tie to $self->{_dbfile}.db";print "LINE=".__LINE__."\n";
my $hostlabel=$_[1];print "LINE=".__LINE__."\n";
my $line=$_[2];print "LINE=".__LINE__."\n";
if (!$line) {
if (wantarray) {
return '','ERROR - no query specified';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::handle_error(
"FullAutoDB: ERROR - no query specified\n");print "LINE=".__LINE__."\n";
}
}
#my $logreset=1;print "LINE=".__LINE__."\n";
#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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;print "LINE=".__LINE__."\n";
my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;print "LINE=".__LINE__."\n";
$line=~s/^.*\s+($rx1|$rx2)$/$1/;print "LINE=".__LINE__."\n";
$line=~/^(\d+)\s+([JFMASOND]\w\w\s+\d+\s+\S+)\s+(.*)$/;print "LINE=".__LINE__."\n";
my $size=$1;my $timestamp=$2;my $filename=$3;print "LINE=".__LINE__."\n";
my $mt='';my $hr=0;my $dy=0;my $mn=0;my $fileyr=0;print "LINE=".__LINE__."\n";
($mn,$dy,$mt)=split /\s+/, $timestamp;print "LINE=".__LINE__."\n";
if (-1<index $mt,':') {
($hr,$mt)=split ':', $mt;print "LINE=".__LINE__."\n";
$fileyr=(localtime)[5];print "LINE=".__LINE__."\n";
} else {
$fileyr=$mt;$mt=0;print "LINE=".__LINE__."\n";
}
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,'*';print "LINE=".__LINE__."\n";
#$Net::FullAuto::FA_Core::log=0 if $logreset;print "LINE=".__LINE__."\n";
$timestamp=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$Net::FullAuto::FA_Core::month{$mn}-1,$fileyr);print "LINE=".__LINE__."\n";
my $ipc_key="$timestamp$size";print "LINE=".__LINE__."\n";
$line="${hostlabel}|%|$line";print "LINE=".__LINE__."\n";
${$self->{_host_queried}}{$hostlabel}='-';print "LINE=".__LINE__."\n";
print "STARTING TIE\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "STARTING TIE\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
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");print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
print "DONE WITH TIE\n" if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
print $Net::FullAuto::FA_Core::MRLOG "DONE WITH TIE\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';print "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $result=0;print "LINE=".__LINE__."\n";
my $dbcopy='';my $status='';print "LINE=".__LINE__."\n";
# print the contents of the file
my ($k, $v) = ("", "") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
my %dbcopy=();print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
$dbcopy{$k}=$v;print "LINE=".__LINE__."\n";
}
undef $cursor ;print "LINE=".__LINE__."\n";
if (exists $dbcopy{$line}) {
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
$result='File has Already been Transferred';print "LINE=".__LINE__."\n";
} elsif (&Net::FullAuto::FA_Core::test_semaphore($ipc_key)) {
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
$result='Another Process is Transferring File';print "LINE=".__LINE__."\n";
} elsif (!$hr && testtime(\%dbcopy,$filename,$size,
$mn,$dy,$rx1,$rx2,$hostlabel)) {
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
$status=$bdb->db_put($line,time);print "LINE=".__LINE__."\n";
$result='File has Already been Transferred';print "LINE=".__LINE__."\n";
} elsif (!$Net::FullAuto::FA_Core::cron) {
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
if (time-$timestamp<600 && $timestamp<time) {
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
return 'File Less then 10 Minutes Old','';print "LINE=".__LINE__."\n";
}
my $acc='';my $ln='';print "LINE=".__LINE__."\n";
($acc,$ln)=split /\|\%\|/, $line;print "LINE=".__LINE__."\n";
$ln=~tr/ //s;print "LINE=".__LINE__."\n";
my $banner="\n The $acc Account File :\n\n $ln\n\n"
." Is Ready to Transfer\n\n Choose One :";print "LINE=".__LINE__."\n";
my @output=("Do NOT Transfer NOW","Do NOT Transfer EVER",
"TRANSFER Now");print "LINE=".__LINE__."\n";
my $output=&Menus::pick(\@output,$banner,7);print "LINE=".__LINE__."\n";
if ($output eq 'Do NOT Transfer NOW') {
return "User Declines to Transfer File Now",'';print "LINE=".__LINE__."\n";
} elsif ($output eq ']quit[') {
&Net::FullAuto::FA_Core::cleanup()
} elsif ($output eq 'Do NOT Transfer EVER') {
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
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");print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $status=$bdb->db_put($line,time);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
return 'User Declines to EVER Transfer File','';print "LINE=".__LINE__."\n";
} else {
&Net::FullAuto::FA_Core::acquire_fa_lock($ipc_key);print "LINE=".__LINE__."\n";
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
}
return 0,'';print "LINE=".__LINE__."\n";
}
} else {
if (time-$timestamp<600) {
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
$result='File Less then 10 Minutes Old';print "LINE=".__LINE__."\n";
} else {
${$self->{_line_queried}}{$line}='-';print "LINE=".__LINE__."\n";
&Net::FullAuto::FA_Core::acquire_fa_lock($ipc_key);print "LINE=".__LINE__."\n";
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 "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
}
}
}
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
return $result,'';print "LINE=".__LINE__."\n";
}
sub testtime
{
my @topcaller=caller;print "LINE=".__LINE__."\n";
print "FA_DB::testtime() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
my $dbcopy=$_[0];print "LINE=".__LINE__."\n";
my $filename=$_[1];print "LINE=".__LINE__."\n";
my $size=$_[2];print "LINE=".__LINE__."\n";
my $mn=$_[3];my $dy=$_[4];print "LINE=".__LINE__."\n";
my $rx1=$_[5];my $rx2=$_[6];print "LINE=".__LINE__."\n";
my $hostlabel=$_[7];print "LINE=".__LINE__."\n";
foreach my $dbline (keys %{$dbcopy}) {
my $dbhostlabel='';print "LINE=".__LINE__."\n";
($dbhostlabel,$dbline)=split /\|\%\|/,$dbline;print "LINE=".__LINE__."\n";
next if $dbhostlabel ne $hostlabel;print "LINE=".__LINE__."\n";
$dbline=~s/^.*\s+($rx1|$rx2)$/$1/;print "LINE=".__LINE__."\n";
$dbline=~/^(\d+)\s+([JFMASOND]\w\w\s+\d+\s+\S+)\s+(.*)$/;print "LINE=".__LINE__."\n";
my $dbsize=$1;my $dbtimestamp=$2;my $dbfilename=$3;print "LINE=".__LINE__."\n";
my $dbmt='';my $dbdy=0;my $dbmn=0;print "LINE=".__LINE__."\n";
($dbmn,$dbdy,$dbmt)=split /\s+/, $dbtimestamp;print "LINE=".__LINE__."\n";
next if -1==index $dbmt,':';print "LINE=".__LINE__."\n";
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,'*';print "LINE=".__LINE__."\n";
if ($filename eq $dbfilename && $size eq $dbsize
&& $mn eq $dbmn && $dy eq $dbdy) {
return 1;print "LINE=".__LINE__."\n";
}
} return 0;print "LINE=".__LINE__."\n";
}
sub mod
{
my $self=shift;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
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");print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my $banner="\n Please Pick a SkipDB Entry to Delete :";print "LINE=".__LINE__."\n";
my ($k,$v) = ("","") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
my @output=();print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
push @output, $k;print "LINE=".__LINE__."\n";
}
undef $cursor;print "LINE=".__LINE__."\n";
my $output=&Menus::pick(\@output,$banner,7);print "LINE=".__LINE__."\n";
my $status=$bdb->db_del($output);print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
}
sub close
{
my @caller=caller;print "LINE=".__LINE__."\n";
print "CLOSE_Caller=",(join ' ',@caller),"\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;print "LINE=".__LINE__."\n";
my $self=shift;print "LINE=".__LINE__."\n";
my $mkdflag=0;print "LINE=".__LINE__."\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
$mkdflag=1;print "LINE=".__LINE__."\n";
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $m=($^O eq 'cygwin')?"-m $mode ":'';print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir '.
$m.$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom';print "LINE=".__LINE__."\n";
my $stdout='';my $stderr='';print "LINE=".__LINE__."\n";
($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr;print "LINE=".__LINE__."\n";
}
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");print "LINE=".__LINE__."\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 "LINE=".__LINE__."\n";
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;print "LINE=".__LINE__."\n";
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom/*';print "LINE=".__LINE__."\n";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);print "LINE=".__LINE__."\n";
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';print "LINE=".__LINE__."\n";
}
my ($k,$v) = ("","") ;print "LINE=".__LINE__."\n";
my $cursor = $bdb->db_cursor() ;print "LINE=".__LINE__."\n";
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
my $hostlabel=substr($k,0,(index $k,'|%|'));print "LINE=".__LINE__."\n";
if (exists ${$self->{_host_queried}}{$hostlabel}
&& !exists ${$self->{_line_queried}}{$k}) {
my $status=$bdb->db_del($k);print "LINE=".__LINE__."\n";
}
}
undef $cursor;print "LINE=".__LINE__."\n";
undef $bdb;print "LINE=".__LINE__."\n";
$dbenv->close();print "LINE=".__LINE__."\n";
undef $dbenv;print "LINE=".__LINE__."\n";
}
package Net::FullAuto::Getline;print "LINE=".__LINE__."\n";
# file: IO/Getline.pm
# Figure 13.2: The Getline module
# line-oriented reading from sockets/handles with access to
# internal buffer.
use strict;print "LINE=".__LINE__."\n";
use Carp 'croak';print "LINE=".__LINE__."\n";
use IO::Handle;print "LINE=".__LINE__."\n";
1