package Net::FullAuto::FA_Core;
### OPEN SOURCE LICENSE - GNU AFFERO PUBLIC LICENSE Version 3.0 #######
#
# Net::FullAuto - Distributed Workload Automation Software
# Copyright © 2000-2016 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;
# echo "FINISHED NUM=$num"; done
#
## For CPAN availability
#
# The Perl NOC (Network Operations Center) http://log.perl.org
#
## 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
#
# cpan -D Module::Name - to check module versions
#
## For root access on Ubuntu and Amazon EC2 servers
#
# sudo su -or- sudo bash -l
#
## 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 Capture::Tiny -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 password-less ssh
#
# a@A: ssh-keygen -t rsa
# a@A: ssh b@B mkdir -p .ssh
# a@A: cat .ssh/id_rsa.pub | ssh b@B 'cat >> .ssh/authorized_keys'
#
## apt-cyg
#
# https://github.com/transcode-open/apt-cyg
#
## 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/
#
## Vim auto-indenting turn off
#
# http://vim.wikia.com/wiki/Toggle_auto-indenting_for_code_paste
# :set paste
#
## Send cmd and do interactive over ssh:
#
# ssh user@host -t 'bash -l -c "ls;bash"'
#
## Check for "Run as Administrator"
#
# http://www.vivtek.com/perl/perl_uac.html
#
## Copyright and other symbols
#
# http://symbolcodes.tlt.psu.edu/accents/codealt.html
#
## Stream file over ssh
#
# http://sshmenu.sourceforge.net/articles/transparent-mulithop.html
# https://blog.bravi.org/?p=259
# https://bbs.archlinux.org/viewtopic.php?id=132276
# www.commandlinefu.com/commands/view/7789/copy-a-file-over-ssh-without-scp
# ssh test@example.org "cd mydir && tar cfp - mysubdir" | tar xvfp -
#
## TO DO: Look for way to fix this error:
#
# cd "/cygdrive_funkyPrompt_cd "/cygdrive/c/Users/KB06606-admin" 2>&1
#
# Look into Parallel ForkManager
#
## To tunnel Windows RDP over SSH
#
# ssh -i fullauto.pem -L 13389:windows_at_aws:3389 ec2-user@linux_at_aws
#
# With local RDP app, connect with localhost:13389
#
## Kill all processess
#
# ps -ef | grep -v grep | grep fullauto | awk '{print $2}' | xargs sudo kill -9
#
## *************************************************************
use strict;
use warnings;
###################################
our $cygwin_berkeley_db_mode = 777;
###################################
our $progname=substr($0,(rindex $0,'/')+1,-3);
our @tran=('','',0,$$."_".$^T,'',0);
$ENV{OS}='' if !$ENV{OS};
$ENV{HISTCONTROL}='ignorespace';
my $md_='';our $thismonth='';our $thisyear='';
($md_,$thismonth,$thisyear)=(localtime)[3,4,5];
my $mo_=$thismonth;my $yr_=$thisyear;
$md_="0$md_" if $md_<10;
$mo_++;$mo_="0$mo_" if $mo_<10;
my $yr__=sprintf("%02d",$yr_%100);
my $yr____=(1900+$yr_);
my $mdy="$mo_$md_$yr__";
my $mdyyyy="$mo_$md_$yr____";
my $tm=scalar localtime($^T);
my $hms=substr($tm,11,8);
$hms=~s/^(\d\d):(\d\d):(\d\d)$/h${1}m${2}s${3}/;
my $hr=$1;my $mn=$2;my $sc=$3;
our $curyear=$thisyear + 1900;
our $curcen=unpack('a2',$curyear);
our @invoked=($^T, $tm, $mdy, $hms, $hr, $mn, $sc, $mdyyyy);
BEGIN {
$main::netfull='';
unless (exists $INC{'Net/FullAuto.pm'}) {
foreach my $fpath (@INC) {
my $f=$fpath;
if (-e $f.'/Net/FullAuto.pm') {
$main::netfull=$f.'/Net/FullAuto.pm';
last;
}
}
} else {
$main::netfull=$INC{'Net/FullAuto.pm'};
}
}
BEGIN {
if ($^O eq 'MSWin32' || $^O eq 'MSWin64') {
print "\n FATAL ERROR! : Cygwin Linux Emulation Layer".
"\n is required to use FullAuto".
"\n on Windows - goto www.cygwin.com.".
"\n\n \(Be sure to install the cygserver ".
"service\).\n\n";
exit;
}
#use if ($^O eq 'cygwin'), 'Win32::Semaphore';
if ($^O eq 'cygwin' && $0 ne 'test.t') {
my $srvout=`/bin/cygrunsrv -Q cygserver 2>&1`;
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";
exit;
} 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";
exit;
}
if (0) {
$srvout=`/bin/cygrunsrv -Q sshd 2>&1`;
if (-1<index $srvout,'Stopped') {
my $ps=`/bin/ps -e`;
if (-1<index $ps,'sshd') {
foreach my $line (split "\n", $ps) {
my $pid=$line;
next unless -1<index $line,'sshd';
$pid=~s/^\s(\d+)\s+.*$/$1/;
`/bin/kill -f $pid`;
}
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";
exit;
}
} 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";
exit;
}
} 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";
exit;
}
my $srvaccount=`sc qc sshd`;
$srvaccount=~s/^.*SERVICE_START_NAME : (?:.\\)*(.*?)\s*$/$1/s;
my $rights=`/bin/editrights -u $srvaccount -l 2>&1`;
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=();
my $output='';my $restart_sshd=0;
if (-1<index $rights,'SeDenyRemoteInteractiveLogonRight') {
my $rt='SeDenyRemoteInteractiveLogonRight';
$output=`/bin/editrights -r $rt -u $srvaccount 2>&1`;
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 $die;
exit 1;
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeTcbPrivilege') {
$output=`/bin/editrights -a SeTcbPrivilege -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeTcbPrivilege';
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeCreateTokenPrivilege') {
my $prv='SeCreateTokenPrivilege';
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeCreateTokenPrivilege';
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeAssignPrimaryTokenPrivilege') {
my $prv='SeAssignPrimaryTokenPrivilege';
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeAssignPrimaryTokenPrivilege';
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeServiceLogonRight') {
my $prv='SeServiceLogonRight';
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeServiceLogonRight';
} else { $restart_sshd=1 }
}
if (-1<$#missing_rights) {
my $mis=join "\n",map { " $_" } @missing_rights;
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 $die;
exit 1;
} elsif ($restart_sshd) {
$srvout=`/bin/cygrunsrv -Q sshd 2>&1`;
my $output=`net stop sshd 2>&1`;
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";
exit;
}
$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 ",
" could NOT be started:\n\n${srvout}".
"Error: $output\n\nTo restart, Run as Administrator\n".
"\nand then: 'net start sshd'\n\n";
exit;
}
}
}
}
}
}
use IPC::Semaphore;
use IPC::SysV qw(IPC_CREAT SEM_UNDO S_IRWXU);
push @INC, substr($main::netfull,0,-3);
}
use warnings;
{
no warnings;
use Socket;
require Exporter;
}
our @ISA = qw(Exporter Net::Telnet Cwd);
our @EXPORT = qw(%Hosts $localhost getpasswd
connect_host get_all_hosts
$username connect_ftp $cron
connect_telnet connect_sftp log
connect_mozrepl $passwd_file_loc
send_email $log connect_ssh $prod
connect_shell connect_secure
connect_insecure connect_reverse
@invoked $cleanup pick Menu $quiet
$progname memnow acquire_semaphore
release_semaphore $savetran %hours
$increment %month ls_parse $batch
cleanup $dest_first_hash %days
test_file test_dir timelocal
%GLOBAL @GLOBAL $LOG $fullauto
$funkyprompt handle_error @plans
$unattended %email_addresses
$adminmenu %email_defaults $proxy
$service $determine_password
persist_get persist_put cache
$berkeleydb %admin_menus $^O
$cache_root $cache_key username
acquire_fa_lock release_fa_lock
$choose_pass_expiration fetch
%monthconv %mimetypes %admin_menu
check_for_amazon_localhost
get_amazon_external_ip $random
fa_welcome get_isets cmd_raw
connect_berkeleydb);
{
no warnings;
use BerkeleyDB;
use Sys::Hostname;
our $local_hostname=&Sys::Hostname::hostname;
use Data::Dump::Streamer;
use Devel::StackTrace;
use Time::Local;
use Crypt::CBC;
use Crypt::DES;
use Cwd qw(getcwd);
use Digest::MD5 qw(md5);
use Digest::SHA qw(sha256_hex);
use English;
use Email::Sender::Simple qw(sendmail);
use Email::Sender::Transport::SMTP qw();
use Errno qw(EAGAIN EINTR EWOULDBLOCK);
use File::HomeDir;
use File::stat;
use File::Copy;
use MIME::Entity;
use Module::Load::Conditional qw[can_load];
use Net::Telnet;
use Getopt::Long;
use Pod::Usage;
use Term::ReadKey;
use Term::RawInput;
use LWP::UserAgent ();
use LWP::MediaTypes qw(guess_media_type media_suffix);
use URI ();
use HTTP::Date ();
use IO::Handle;
use IO::Select;
use IO::Capture::Stderr;
use Capture::Tiny;
use String::Random;
use Symbol qw(qualify_to_ref);
use Tie::Cache;
use IO::Pty;
use POSIX qw(setsid uname getuid geteuid);
};
our $home_dir='~';
if (exists $ENV{HOME} && -d $ENV{HOME}) {
$home_dir=$ENV{HOME};
} elsif (exists $ENV{USER} && $ENV{USER}) {
if (-d "/home/$ENV{USER}") {
$home_dir="/home/$ENV{USER}";
} elsif (-d "/export/home/$ENV{USER}") {
$home_dir="/export/home/$ENV{USER}";
}
} elsif ((getpwuid($<))[7]) {
$home_dir=(getpwuid($<))[7];
}
BEGIN {
my $md_='';our $thismonth='';our $thisyear='';
($md_,$thismonth,$thisyear)=(localtime)[3,4,5];
my $mo_=$thismonth;my $yr_=$thisyear;
$md_="0$md_" if $md_<10;
$mo_++;$mo_="0$mo_" if $mo_<10;
my $yr__=sprintf("%02d",$yr_%100);
my $yr____=(1900+$yr_);
my $mdy="$mo_$md_$yr__";
my $mdyyyy="$mo_$md_$yr____";
my $tm=scalar localtime($^T);
my $hms=substr($tm,11,8);
$hms=~s/^(\d\d):(\d\d):(\d\d)$/h${1}m${2}s${3}/;
my $hr=$1;my $mn=$2;my $sc=$3;
our $curyear=$thisyear + 1900;
our $curcen=unpack('a2',$curyear);
our @invoked=($^T, $tm, $mdy, $hms, $hr, $mn, $sc, $mdyyyy);
my $customdir='Net/FullAuto/Custom';
our $fa_conf='';
if (defined $Term::Menus::fa_conf) {
$fa_conf=$Term::Menus::fa_conf;
if (defined $fa_conf->[0]) {
eval {
require $fa_conf->[0];
my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3);
import $mod;
$fa_conf=$mod.'.pm';
};
}
}
our $fa_host='';
if (defined $Term::Menus::fa_host) {
$fa_host=$Term::Menus::fa_host;
if (defined $fa_host->[0]) {
eval {
require $fa_host->[0];
my $mod=substr($fa_host->[0],(rindex $fa_host->[0],'/')+1,-3);
import $mod;
$fa_host=$mod.'.pm';
};
}
}
our $fa_menu='';
if (defined $Term::Menus::fa_menu) {
$fa_menu=$Term::Menus::fa_menu;
if (defined $fa_menu->[0]) {
eval {
require $fa_menu->[0];
my $mod=substr($fa_menu->[0],(rindex $fa_menu->[0],'/')+1,-3);
import $mod;
$fa_menu=$mod.'.pm';
};
}
}
our $sftpport='';
our $sftpifil='';
sub sftport {
$Net::FullAuto::FA_Core::sftpport='';
my $sftppath=$_[0];
my $sftport=`${sftppath}sftp 2>&1`;
my $sftpidf='';
if ($sftport) {
if ($sftport=~/-P sftp_server_path/s) {
$sftport='-oPort=';
$sftpidf='-oIdentityFile=';
} else {
$sftport='-P ';
$sftpidf='-i ';
}
$Net::FullAuto::FA_Core::sftpport=$sftport;
$Net::FullAuto::FA_Core::sftpifil=$sftpidf;
}
}
my $win2unix=sub {
my $slash=$_[0];
$slash=~s/\\/\//g;
return $slash;
};
our $gbp=sub { # Get Bin Path
my $cmd=$_[0];
my $handle=$_[1]||'';
my $hostlabel=$_[2]||'';
$Net::FullAuto::FA_Core::cmdinfo={}
unless $Net::FullAuto::FA_Core::cmdinfo;
my $object=($handle)?$handle:$Net::FullAuto::FA_Core::cmdinfo;
unless (exists $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}) {
my $stdout='';my $stderr='';
if (exists $Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{$cmd}) {
my $cmdpath=
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{$cmd};
$cmdpath.='/' if $cmdpath!~/\/$/;
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=$cmdpath;
return $cmdpath;
}
if ($handle) {
if (ref $handle eq 'Net::Telnet') {
my $shell='';
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$handle,
_hostlabel=>[ $hostlabel,'' ] },
'env');
if ($stdout=~/^SHELL=(.*)$/m) {
$shell=$1;chomp $shell;
}
if ((-1<index $shell, 'bash') ||
(-1<index $shell, 'ksh')) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$handle,
_hostlabel=>[ $hostlabel,'' ] },
"if [ -f /bin/$cmd ];then echo \"FOUND\";fi");
($stdout,$stderr)=$handle->cmd(
"if [ -f /bin/$cmd ];then echo \"FOUND\";fi") unless
-1<index $stdout,'FOUND';
if (-1<index $stdout,'FOUND') {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/bin/";
return "/bin/";
}
($stdout,$stderr)=$handle->cmd(
"if [ -f /usr/bin/$cmd ];then echo \"FOUND\";fi");
print "STDOUT=$stdout<==\n";
if (-1<index $stdout,'FOUND') {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/usr/bin/";
return "/usr/bin/";
}
}
} else {
unless (exists $handle->{_shell}) {
($stdout,$stderr)=$handle->cmd('env');
if ($stdout=~/^SHELL=(.*)$/m) {
my $shell=$1;chomp $shell;
$handle->{_shell}=$shell;
}
}
if ((-1<index $handle->{_shell}, 'bash') ||
(-1<index $handle->{_shell}, 'ksh')) {
($stdout,$stderr)=$handle->cmd(
"if [ -f /bin/$cmd ];then echo \"FOUND\";fi");
print "STDOUT=$stdout<==\n";
if (-1<index $stdout,'FOUND') {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/bin/";
return "/bin/";
}
}
}
} elsif (-e "/usr/bin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/usr/bin/";
sftport("/usr/bin/") if $cmd eq 'sftp';
return "/usr/bin/";
} elsif (-e "/bin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/bin/";
sftport("/bin/") if $cmd eq 'sftp';
return "/bin/";
} elsif (-e "/usr/local/bin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/usr/local/bin/";
sftport("/usr/local/bin/") if $cmd eq 'sftp';
return "/usr/local/bin/";
} 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";
} else {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
$win2unix->($ENV{'WINDIR'})."/system32/${cmd}.exe";
}
sftport("$win2unix->($ENV{'WINDIR'}).'/system32/'")
if $cmd eq 'sftp';
return $win2unix->($ENV{'WINDIR'}).'/system32/';
} elsif (-e "/etc/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/etc/";
sftport("/etc/") if $cmd eq 'sftp';
return "/etc/";
} elsif (-e "/usr/sbin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/usr/sbin/";
sftport("/usr/sbin/") if $cmd eq 'sftp';
return "/usr/sbin/";
} elsif (-e "/sbin/$cmd") {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
"/sbin/";
sftport("/sbin/") if $cmd eq 'sftp';
return "/sbin/";
} elsif ($Net::FullAuto::FA_Core::gbp->('which')) {
my $which=$Net::FullAuto::FA_Core::gbp->('which');
my $found=`${which}which $cmd`;
if (-e $found and $found!~/Command not found/i) {
$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
$found;
} else { return '' }
}
} else {
return $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd};
}
};
our $termwidth=''; our $termheight='';
if (!$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug) {
eval {
no strict 'subs';
($termwidth, $termheight) = GetTerminalSize(STDOUT);
};
if ($@) {
$termwidth='';$termheight='';
}
}
our %admin_menus=(
'define_module_from_viewdef' => '',
'defaultsettings' => '',
'viewdefaults' => '',
'cacode' => '',
'cahost' => '',
'caconf' => '',
'camenu' => '',
'cacomm' => '',
'admin' => '',
'plan' => '',
'define_modules_commit' => '',
'define_modules_menu_fa_menu' => '',
'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' => '',
);
our $locks = {
1234 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable_This_Lock => 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_This_Lock => 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,
},
9854 => {
MaxNumberAllowed => 1,
KillAfterSeconds => 300,
Enable_This_Lock => 1,
Lock_Description =>
'Password Input Lock',
Wait_For_NewLock => 60,
PollingMilliSecs => 500,
},
9876 => {
MaxNumberAllowed => 2,
KillAfterSeconds => 300,
Enable_This_Lock => 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_This_Lock => 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,
},
};
use Fcntl qw(S_IMODE O_WRONLY O_CREAT);
our $fa_perm=S_IMODE((CORE::stat($main::netfull))[2]);
}
# 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,$famenu,$passwrd,
$users,$usrname,$import,$export,$VERSION,%GLOBAL,@GLOBAL,
$identityfile,$tutorial,$figlet,$passwrdnw,$go,$iset_amazon,
$iset_local);
# Globally Scoped and Intialized Variables.
our $blanklines='';our $oldpasswd='';our $authorize_connect='';
our $scrub=0;our $pcnt=0;our $chk_id='';our $d_sub='';
our $deploy_info='';our $f_sub='';our $updatepw=0;
our $shown='';our $websphere_not_running=0;my @hours=();
our $master_hostlabel='';our $random=0;our @plans=();
our $parent_menu='';our @menu_args=();our $savetran=0;
our $LOG='';our @pid_ts=();our %drives=();our @month=();
our $username='';our @passwd=('','');our %cygpathw=();
our $localhost={};our %localhost=();our %cygpathu=();
our @RCM_Link=();our @FTM_Link=();our $cleanup=0;our %Maps=();
our $starting_memory=0;our $custom_code_module_file='';
our %email_addresses=();our $debug=0;our %tiedb=();
our @ascii_que=();our $passetts=['','',''];
our %Connections=();our $tranback=0;our @ascii=();our $uhray='';
our %base_excluded_dirs=();our %base_excluded_files=();
our %hours=();our %Hosts=();our $berkeleydb='';
our %same_host_as_Master=("__Master_${$}__"=>'-','localhost'=>'-');
our @same_host_as_Master=();our $dest_first_hash='';
our %file_rename=();our %rename_file=();our $quiet='';
our %filerename=();our %renamefile=();our %fullmonth=();
our %Processes=();our %shellpids=();our %ftpcwd=();our $newuser='';
our $master_transfer_dir='';our $proxy='';
our %perms=();our @ApacheNode=();our $test=0;our %days=();
our $prod=0;our $force_pause_for_exceed=0;our $tosspass=0;
our $timeout=60;our $cltimeout='X';our $slave=0;our $dcipher='';
our %email_defaults=();our $increment=0;our %tosspass=();
our $email_defaults='';our %semaphores=();our $batch='';
our $unattended='';our %month=();our $fullauto='';our $service='';
our @dhostlabels=();our %monthconv=();our $cache_root='';
our $cache_key='';our $admin='';our $menu='';our $welcome='';
our %hourconv=();our @weekdays=();our %weekdaysconv=();
our %mimetypes=();our $skip_host_hash='';
our $crypt_cipher='DES';our $save_main_pass=0;
our $password_from='user_input';our $amazoncleanup='';
our $funkyprompt='\\\\137\\\\146\\\\165\\\\156\\\\153\\\\171\\\\120'.
'\\\\162\\\\157\\\\155\\\\160\\\\164\\\\137';
our $specialperms='none';our $gatekeep_expir_shown=0;
{
my $ex=$0;
if ($^O eq 'cygwin') {
$ex=~s/\.pl$/\.exe/;
} else {
$ex=~s/\.pl$//;
}
if (-u $ex) {
umask(077);
$specialperms='setuid';
} elsif (-g $ex) {
umask(007);
$specialperms='setgid';
}
};
%hours=('01'=>'01a','02'=>'02a','03'=>'03a','04'=>'04a',
'05'=>'05a','06'=>'06a','07'=>'07a','08'=>'08a',
'09'=>'09a','10'=>'10a','11'=>'11a','00'=>'12a',
'13'=>'01p','14'=>'02p','15'=>'03p','16'=>'04p',
'17'=>'05p','18'=>'06p','19'=>'07p','20'=>'08p',
'21'=>'09p','22'=>'10p','23'=>'11p','12'=>'12p',
'01a'=>'01','02a'=>'02','03a'=>'03','04a'=>'04',
'05a'=>'05','06a'=>'06','07a'=>'07','08a'=>'08',
'09a'=>'09','10a'=>'10','11a'=>'11','12a'=>'00',
'01p'=>'13','02p'=>'14','03p'=>'15','04p'=>'16',
'05p'=>'17','06p'=>'18','07p'=>'19','08p'=>'20',
'09p'=>'21','10p'=>'22','11p'=>'23','12p'=>'12');
@hours=('12:00am',' 1:00am',' 2:00am',' 3:00am',' 4:00am',
' 5:00am',' 6:00am',' 7:00am',' 8:00am',' 9:00am',
'10:00am','11:00am','12:00pm',' 1:00pm',' 2:00pm',
' 3:00pm',' 4:00pm',' 5:00pm',' 6:00pm',' 7:00pm',
' 8:00pm',' 9:00pm','10:00pm','11:00pm');
%hourconv=('12:00am'=>0,' 1:00am'=>1,' 2:00am'=>2,' 3:00am'=>3,
' 4:00am'=>4,' 5:00am'=>5,' 6:00am'=>6,' 7:00am'=>7,
' 8:00am'=>8,' 9:00am'=>9,'10:00am'=>10,'11:00am'=>11,
'12:00pm'=>12,' 1:00pm'=>13,' 2:00pm'=>14,' 3:00pm'=>15,
' 4:00pm'=>16,' 5:00pm'=>17,' 6:00pm'=>18,' 7:00pm'=>19,
' 8:00pm'=>20,' 9:00pm'=>21,'10:00pm'=>22,'11:00pm'=>23);
@weekdays=('Sunday ','Monday ','Tuesday ','Wednesday',
'Thursday ','Friday ','Saturday ');
%weekdaysconv=('Sunday'=>1,'Monday'=>2,'Tuesday'=>3,
'Wednesday'=>4,'Thursday'=>5,'Friday'=>6,
'Saturday'=>7);
%month=('01'=>'Jan','02'=>'Feb','03'=>'Mar','04'=>'Apr',
'05'=>'May','06'=>'Jun','07'=>'Jul','08'=>'Aug',
'09'=>'Sep','10'=>'Oct','11'=>'Nov','12'=>'Dec',
'Jan'=>'01','Feb'=>'02','Mar'=>'03','Apr'=>'04',
'May'=>'05','Jun'=>'06','Jul'=>'07','Aug'=>'08',
'Sep'=>'09','Oct'=>'10','Nov'=>'11','Dec'=>'12');
@month=('January ','February ','March ',
'April ','May ','June ','July ',
'August ','September','October ','November ',
'December ');
%monthconv=('January '=>1,'February'=>2,'March '=>3,
'April '=>4,'May '=>5,'June '=>6,
'July '=>7,'August '=>8,'September'=>9,
'October '=>10,'November'=>11,'December'=>12);
%fullmonth=('Jan'=>'January','Feb'=>'February','Mar'=>'March',
'Apr'=>'April','May'=>'May','Jun'=>'June',
'Jul'=>'July','Aug'=>'August','Sep'=>'September',
'Sept'=>'September','Oct'=>'October',
'Nov'=>'November','Dec'=>'December',
'January'=>'Jan','February'=>'Feb','March'=>'Mar',
'April'=>'Apr','May'=>'May','June'=>'Jun',
'July'=>'Jul','August'=>'Aug','September'=>'Sep',
'October'=>'Oct','November'=>'Nov',
'December'=>'Dec');
%days=('Mon'=>'Monday','Tue'=>'Tuesday','Tues'=>'Tuesday',
'Wed'=>'Wednesday','Thu'=>'Thursday','Thur'=>'Thursday',
'Thurs'=>'Thursday','Fri'=>'Friday','Sat'=>'Saturday',
'Sun'=>'Sunday','Monday'=>'Mon','Tuesday'=>'Tue',
'Wednesday'=>'Wed','Thursday'=>'Thu','Friday'=>'Fri',
'Sat'=>'Saturday','Sun'=>'Sunday','0'=>'Sunday',
'1'=>'Monday','2'=>'Tuesday','3'=>'Wednesday',
'4'=>'Thursday','5'=>'Friday','6'=>'Saturday');
%perms=('rwx'=>'7','rw-'=>'6','r-x'=>'5','r--'=>'4',
'-wx'=>'3','-w-'=>'2','--x'=>'1','---'=>'0',
'rwt'=>'7','rwT'=>'6','r-t'=>'5','r-T'=>'4',
'-wt'=>'3','-wT'=>'2','--t'=>'1','--T'=>'0',
'rws'=>'7','rwS'=>'6','r-s'=>'5','r-S'=>'4',
'-ws'=>'3','-wS'=>'2','--s'=>'1','--S'=>'0');
@ascii=(['10','012','061','060'],['11','013','061','061'],
['12','014','061','062'],['13','015','061','063'],
['14','016','061','064'],['15','017','061','065'],
['16','020','061','066'],['17','021','061','067'],
['18','022','061','070'],['19','023','061','071'],
['20','024','062','060'],['21','025','062','061'],
['22','026','062','062'],['23','027','062','063'],
['24','030','062','064'],['25','031','062','065'],
['26','032','062','066'],['27','033','062','067'],
['28','034','062','070'],['29','035','062','071'],
['30','036','063','060'],['31','037','063','061'],
['32','040','063','062'],['33','041','063','063'],
['34','042','063','064'],['35','043','063','065'],
['36','044','063','066'],['37','045','063','067'],
['38','046','063','070'],['39','047','063','071'],
['40','050','064','060'],['41','051','064','061'],
['42','052','064','062'],['43','053','064','063'],
['44','054','064','064'],['45','055','064','065'],
['46','056','064','066'],['47','057','064','067'],
['48','060','064','070'],['49','061','064','071'],
['50','062','065','060'],['51','063','065','061'],
['52','064','065','062'],['53','065','065','063'],
['54','066','065','064'],['55','067','065','065'],
['56','070','065','066'],['57','071','065','067'],
['58','072','065','070'],['59','073','065','071'],
['60','074','066','060'],['61','075','066','061'],
['62','076','066','062'],['63','077','066','063']);
#['64','100','066','064'],['65','101','066','065'],
#['66','102','066','066'],['67','103','066','067'],
#['68','104','066','070'],['69','105','066','071'],
#['70','106','067','060'],['71','107','067','061'],
#['72','110','067','062'],['73','111','067','063'],
#['74','112','067','064'],['75','113','067','065'],
#['76','114','067','066'],['77','115','067','067'],
#['78','116','067','070'],['79','117','067','071'],
#['80','120','070','060'],['81','121','070','061'],
#['82','122','070','062'],['83','123','070','063'],
#['84','124','070','064'],['85','125','070','065'],
#['86','126','070','066'],['87','127','070','067'],
#['88','130','070','070'],['89','131','070','071'],
#['90','132','071','060'],['91','133','071','061'],
#['92','134','071','062'],['93','135','071','063'],
#['94','136','071','064'],['95','137','071','065'],
#['96','140','071','066'],['97','141','071','067'],
#['98','142','071','070'],['99','143','071','071']);
%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',
);
@ascii_que=@ascii;
#if ($^O ne 'cygwin') {
# If using an exceed X-window launched from
# a desktop icon and configured to launch
# this script/program automatically, then
# set $force_pause_for_exceed to pause the
# script before a forced exit following an
# error condition.
#print "HOMEDIR=$home_dir and UID=$UID and EUID=$EUID\n";<STDIN>;
# open (FH,"<$home_dir/.sh_history") ||
# warn "Cannot open .sh_history file! : $!";
# my @command_history=<FH>;
# CORE::close(FH);
# foreach (@command_history) {
# if (/xterm/ and /$0/) {
# $force_pause=1;last;
# }
# }
#}
# our $maintainer='Brian Kelly';
# our $maintainer_phone='';
@FTM_Link=('sftp','ftp'); # Options: ftp sftp
my $count=0;
# Set Blanklines
if ($^O eq 'cygwin') {
while ($count++!=5) { $blanklines.="\n" }
} else {
while ($count++!=5) { $blanklines.="\n" }
}
sub old_cpan {
foreach my $inc (@INC) {
if (-e $inc.'/CPAN/Config.pm') {
unless (-e $inc.'/CPAN/SQLite.pm') {
my $cmd='sed -i \'s/^\\(.*use_sqlite.*q\\).*$/'.
'\\1[0],/\''." $inc/CPAN/Config.pm";
`$cmd` || print $!;
}
return 1;
}
}
}
sub find_kids {
my $process=$_[0];
my $family=$_[1];
my $ppid=$_[2];
my $pid=$_[3];
push @{$family},$process;
if (exists $ppid->{$process}) {
foreach my $child (@{$ppid->{$process}}) {
$family=return find_kids($child,$family,
$ppid,$pid);
my $ppid_of_child=-1;
$ppid_of_child=$pid->{$child} if exists
$pid->{$child};
unless ($ppid_of_child==-1) {
$family=return find_kids($ppid_of_child,
$family,$ppid,$pid);
}
}
} return $family;
}
sub test_for_amazon_ec2 {
if ($^O eq 'linux' || $^O eq 'freebsd') {
if ((-e "/etc/system-release-cpe") &&
(-1<index `cat /etc/system-release-cpe`,'amazon:linux')) {
$main::amazon{'ami'}='';
$main::system_type='ami';
} elsif ((-e "/etc/os-release") &&
(-1<index `cat /etc/os-release`,'ubuntu')) {
if (-e "/usr/bin/ec2metadata") {
$main::amazon{'ubuntu'}='';
}
$main::system_type='ubuntu';
} elsif ($^O eq 'freebsd') {
if ((-e "/usr/local/bin/aws") &&
(-1<index `cat /usr/local/bin/aws`,'aws.amazon')) {
$main::amazon{'freebsd'}='';
}
$main::system_type='freebsd';
} elsif (-e "/etc/SuSE-release") {
if (-e "/etc/profile.d/amazonEC2.sh") {
$main::amazon{'suse'}='';
}
$main::system_type='suse';
} elsif ((-e "/etc/system-release-cpe") &&
(-1<index `cat /etc/system-release-cpe`,
'fedoraproject')) {
if (-e "/etc/yum/pluginconf.d/amazon-id.conf") {
$main::amazon{'fedora'}='';
}
$main::system_type='fedora';
} elsif ((-e "/etc/system-release-cpe") &&
(-1<index `cat /etc/system-release-cpe`,
'redhat:enterprise_linux')) {
if (-e "/etc/yum/pluginconf.d/amazon-id.conf") {
$main::amazon{'rhel'}='';
}
$main::system_type='rhel';
} elsif ((-e "/etc/system-release-cpe") &&
(-1<index `cat /etc/system-release-cpe`,
'centos:linux')) {
if ((-e "/sys/hypervisor/compilation/compiled_by") &&
(-1<index `cat /sys/hypervisor/compilation/compiled_by`,
'amazon')) {
$main::amazon{'centos'}='';
}
$main::system_type='centos';
} elsif (-e "/etc/gentoo-release") {
if ((-e "/sys/hypervisor/compilation/compiled_by") &&
(-1<index `cat /sys/hypervisor/compilation/compiled_by`,
'amazon')) {
$main::amazon{'gentoo'}='';
}
$main::system_type='gentoo';
}
} else { $main::system_type=$^O }
}
# cleanup subroutine called during normal & abnormal terminations
sub cleanup {
my @topcaller=caller;
my $param_one=$_[0]||'';
my $param_two=$_[1]||'';
my ($stdout,$stderr,$track)=('','','');
my $trace = Devel::StackTrace->new();
print "\nINFO: main::cleanup() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::cleanup() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (keys %semaphores) {
foreach my $ipc_key (keys %semaphores) {
$ipc_key||='';
next if $ipc_key=~/^\s*$/;
if (-1<index $semaphores{$ipc_key},'IPC::') {
my $val=$semaphores{$ipc_key}->getval(0)||0;
if (1<$val) {
$semaphores{$ipc_key}->op(0,-1,&SEM_UNDO);
} else {
$semaphores{$ipc_key}->remove;
}
} else {
$semaphores{$ipc_key}->wait(0);
}
}
}
if ($Net::FullAuto::FA_Core::bdb_locks) {
my $cursor=$Net::FullAuto::FA_Core::bdb_locks->db_cursor();
my ($lockid,$locks)=('','');
while (defined $cursor && $cursor->c_get($lockid, $locks, DB_NEXT) == 0) {
$locks=~s/\$HASH\d*\s*=\s*//s;
my $locks=eval $locks;
my @processes=keys %{$locks};
if (-1==$#processes) {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_del($lockid);
next;
}
foreach my $process (@processes) {
if ($process eq $$) {
delete $locks->{$process};
}
}
if (keys %{$locks}) {
$locks=Data::Dump::Streamer::Dump($locks)->Out();
my $status=
$Net::FullAuto::FA_Core::bdb_locks->db_put($lockid,$locks);
} else {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_del($lockid);
}
}
$cursor->c_close() if defined $cursor;
undef $cursor;
$Net::FullAuto::FA_Core::bdb_locks->db_close();
undef $Net::FullAuto::FA_Core::bdb_locks;
}
my $tm='';my $ob='';my %cleansync=();
my $new_cmd='';my $cmd='';my $clean_master='';
my @cmd=();my %did_tran=();
my $kill_arg=($^O eq 'cygwin')?'f':9;
foreach my $hostlabel (keys %Processes) {
foreach my $id (keys %{$Processes{$hostlabel}}) {
foreach my $type (reverse sort keys
%{$Processes{$hostlabel}{$id}}) {
my ($cnct_type,$id_type)=split /_/, $type;
my $show1="CNCT_TYPE=$cnct_type and HOSTLABEL=$hostlabel "
."and PROCESS=".$Processes{$hostlabel}{$id}{$type}."<==\n";
print $show1 if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG $show1
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($cnct_type eq 'ftm') {
my ($ftp_fh,$ftp_pid,$shell_pid,$ig_nore)=
@{$Processes{$hostlabel}{$id}{$type}};
if (defined fileno $ftp_fh) {
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
SC: while (defined fileno $ftp_fh) {
$ftp_fh->print("\004");
print "FTP_FH_ERRMSG=",$ftp_fh->errmsg,"\n"
if $ftp_fh->errmsg
&& $Net::FullAuto::FA_Core::debug;
my $ftploopcount=0;
while (my $line=$ftp_fh->get(timeout=>2)) {
print $Net::FullAuto::FA_Core::LOG
"cleanup() LINE_2=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last if $line=~/_funkyPrompt_$|
logout|221\sGoodbye/sx;
last SC if
$line=~/Connection.*closed|Exit\sstatus\s0/s;
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last SC if $count++==20;
} else { $count=0 }
if ($^O eq 'cygwin' ||
(-1<index $line,'password:') || $ftploopcount) {
$ftp_fh->print("\004");
select(undef,undef,undef,0.02);
} else {
$ftploopcount=1;
$ftp_fh->print('bye');
select(undef,undef,undef,0.02);
# sleep for 1/50th second;
}
}
}
};
if ($@) {
print "WHAT IS THE LINE_2 EVALERROR=$@<====\n"
if $Net::FullAuto::FA_Core::debug;
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';
} else { $ftp_fh->close();die "$@ $!" }
}
}
if (($tran[0] || $hostlabel eq "__Master_${$}__")
&& !exists $did_tran{$hostlabel}) {
$clean_master=1;
if ($^O eq 'cygwin') {
$clean_master=2 if $tran[2];
$clean_master=3 if $tran[4]
&& $clean_master!=2;
} $did_tran{$hostlabel}='-';
}
($stdout,$stderr)=&kill($shell_pid,$kill_arg)
if &testpid($shell_pid);
($stdout,$stderr)=&kill($ftp_pid,$kill_arg)
if &testpid($ftp_pid);
$ftp_fh->close();
} else {
my ($cmd_fh,$cmd_pid,$shell_pid,$cmd)=
@{$Processes{$hostlabel}{$id}{$type}};
if (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];
my $tdir=$element->[1];
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"cd $tmpdir");
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"rm -rf $tdir");
}
}
if (defined fileno $cmd_fh) {
my $gone=1;my $was_a_local=0;my $exit_flag=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
CC: while (defined fileno $cmd_fh) {
$cmd_fh->print(' '.
$Net::FullAuto::FA_Core::gbp->('printf').
"printf $funkyprompt");
while (my $line=$cmd_fh->get(timeout=>2)) {
print $Net::FullAuto::FA_Core::LOG
"cleanup() LINE_3=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (-1<index $line,'logout') {
if (-1<index $line,'Exit status') {
last CC;
} else {
last;
}
} elsif ($line=~/221\sGoodbye/sx) {
last;
}
my %tmp_files_dirs=
%Net::FullAuto::FA_Core::tmp_files_dirs;
if ($line=~/_funkyPrompt_$/s) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&clean_filehandle($cmd_fh);
if ($cfh_error eq 'Exit status') {
last CC;
} else {
if (!$exit_flag && !$savetran) {
if (exists $tmp_files_dirs{$cmd_fh}) {
my $tmpdir=
${$tmp_files_dirs{$cmd_fh}}[0];
my $tdir=${$tmp_files_dirs{$cmd_fh}}[1];
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"cd $tmpdir");
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"rm -rf $tdir");
}
if ($tran[3]) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"cd $tran[0]");
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"rm -f transfer$tran[3].tar");
if ($tran[4]) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },
"cmd /c rmdir /s /q ".
"transfer$tran[3]");
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]);
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ]
},
"cmd /c rmdir /s /q ".
"transfer$tran[3]");
}
}
}
} $did_tran{$hostlabel}='-';
$exit_flag=1;
$cmd_fh->print(' exit');
}
} elsif (($line=~/Killed|_funkyPrompt_/s) ||
($line=~/[:\$%>#-] ?$/s) ||
($line=~/sion denied.*[)][.]\s*$/s)) {
print $Net::FullAuto::FA_Core::LOG
"cleanup() SHOULD BE LAST CC=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($line=~/printf/) {
$cmd_fh->print("\004");
next;
}
$gone=0;last CC;
} elsif (-1<index $line,'Exit status') {
last CC;
} elsif (-1<index $line,
'Connection to localhost closed') {
$was_a_local=1;
last CC;
} elsif ($line=~/Connection.*closed/s) {
last CC;
}
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last CC if $count++==20;
} else { $count=0 }
if (-1<index $line,'password:'
|| -1<index $line,'Permission denied') {
$cmd_fh->print("\004");
}
}
}
};
print "WOW I ACTUALLY GOT OUT3 and GONE=$gone ",
"and WASALOCAL=$was_a_local AND CMD_ERR=",
$cmd_fh->errmsg,"<==\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
if ($@) {
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';
} else { $cmd_fh->close();die "$@ $!" }
}
print $Net::FullAuto::FA_Core::LOG
"cleanup() I GOT TO WAS A LOCAL\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($tran[0] && !exists $did_tran{$hostlabel}) {
$clean_master=1;
if ($^O eq 'cygwin') {
$clean_master=2 if $tran[2];
$clean_master=3 if $tran[4]
&& $clean_master!=2;
}
} elsif ($tran[3] && !$savetran) {
if ($was_a_local) {
$localhost->cmd("rm -f transfer$tran[3]*tar")
if ref $localhost eq 'GLOB';
} elsif (!$gone) {
if ($Net::FullAuto::FA_Core::alarm_sounded) {
$cmd_fh->print("\003");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_fh);
($stdout,$stderr)=&kill($shell_pid,$kill_arg);
($stdout,$stderr)=&kill($cmd_pid,$kill_arg);
last;
}
$cmd_fh->print(" rm -f transfer$tran[3]*tar");
my $lin='';my $cownt=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
while (my $line=$cmd_fh->get) {
$lin.=$line;
$lin=~s/\s*$//s;
if ($lin=~/_funkyPrompt_/s ||
$lin=~/assword: ?$/m ||
$lin=~/Exit\sstatus\s0/m ||
$lin=~/sion denied.*[)][.]\s*$/s ||
$lin=~/[$|%|>|#|-|:] ?$/s) {
last;
} elsif ($lin=~/(Connection.+close.+)$|
Exit\sstatus\s-1$|
Killed\sby\ssignal\s2\.$/xm) {
my $one=$1;$one||='';
if ($one=~/local.+close/) {
$was_a_local=1;last;
} elsif ($one=~/Connection clo/) {
$gone=1;last;
}
} elsif ($cownt++<20) {
$gone=1;last;
} else { $cmd_fh->print("\003") }
}
};
}
}
print $Net::FullAuto::FA_Core::LOG
"GOT EVEN FARTHER HERE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($was_a_local) {
foreach my $pid_ts (@pid_ts) {
$localhost->cmd("rm -f *${pid_ts}*");
}
} elsif (!$gone) {
foreach my $pid_ts (@pid_ts) {
$cmd_fh->cmd("rm -f *${pid_ts}*");
}
}
if (!$was_a_local && !$gone) {
$cmd_fh->autoflush(1);
eval {
$cmd_fh->print(' exit');
while (my $line=$cmd_fh->get) {
$line=~s/\s//g;
if ($line=~/onnection.*close/
|| $line=~/_funkyPrompt_/
|| $line=~/siondenied.*[)][.]$/
|| $line=~/logout/
|| $line=~/cleanup/
|| $line=~/Exitstatus(0|-1)/
|| $line=~/exit\s*$/s
|| $line=~/[$|%|>|#|-|:]$/) {
$cmd_fh->close;last;
}
}
};
}
if (&testpid($shell_pid)) {
eval {
print $Net::FullAuto::FA_Core::LOG
"WHAT IS SHELL_PID=$shell_pid "
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
};
print $Net::FullAuto::FA_Core::LOG
"LINE ".__LINE__." ERROR=$@\n"
if $@ && $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
eval {
$localhost->{_sh_pid}||='';
print $Net::FullAuto::FA_Core::LOG
"and \$\$=$$ and ".
"$localhost->{_sh_pid}\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
};
print $Net::FullAuto::FA_Core::LOG
"LINE ".__LINE__." ERROR=$@\n"
if $@ && $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($stdout,$stderr)=&kill($shell_pid,$kill_arg)
}
print $Net::FullAuto::FA_Core::LOG
"GETTING READY TO KILL!!!!! CMD\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($stdout,$stderr)=&kill($cmd_pid,$kill_arg)
if &testpid($cmd_pid);
}
}
}
}
}
if ($clean_master) {
print $Net::FullAuto::FA_Core::LOG
"INFO: &cleanup() GOING TO CLEAN MASTER\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($tran[3] && exists $localhost->{_cmd_handle}) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost->{_cmd_handle});
&handle_error("CLEANUP ERROR -> $cfh_error",'-1') if $cfh_error
&& (-1==index $cfh_error,'Connection to localhost closed');
($stdout,$stderr)=$localhost->cwd($master_transfer_dir);
&handle_error("CLEANUP ERROR -> $stderr",'-1') if $stderr;
($stdout,$stderr)=
$localhost->cmd("rm -f transfer$tran[3]*tar");
($stdout,$stderr)=
$localhost->cmd("rm -f transfer$tran[3]*tar")
if $stderr;
&handle_error("CLEANUP ERROR -> $stderr",'-1') if $stderr
&& $stderr!~/^\[[A|C](\[C)+\[K1\s*/s;
if ($^O eq 'cygwin') {
if ($clean_master==2) {
$localhost->cmd('cd ..');
}
if ($clean_master==2 || $clean_master==3) {
$localhost->cmd(
"cmd /c rmdir /s /q transfer$tran[3]");
if (&test_dir($localhost,
"transfer$tran[3]")) {
$localhost->cmd(
"chmod -Rv 777 transfer$tran[3]");
$localhost->cmd(
"cmd /c rmdir /s /q transfer$tran[3]")
if !$savetran;
}
}
}
}
foreach my $pid_ts (@pid_ts) {
$localhost->cmd("rm -f *${pid_ts}*");
}
}
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];
my $tdir=$element->[1];
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$localhost->{_cmd_handle},
_hostlabel=>[ "__Master_${$}__",'' ] },"cd $tmpdir");
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$localhost->{_cmd_handle},
_hostlabel=>[ "__Master_${$}__",'' ] },"rm -rf $tdir");
}
}
$localhost->{_cmd_handle}||='';
if (defined fileno $localhost->{_cmd_handle}) {
$localhost->{_cmd_handle}->autoflush(1);
$localhost->{_cmd_handle}->print("\004");
my $next=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
my $lyne='';
while (my $line=$localhost->{_cmd_handle}->get(timeout=>2)) {
$lyne.=$line;
print $Net::FullAuto::FA_Core::LOG
"localhost cleanup() LINE=$line<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "localhost cleanup() LINE=$line<==\n"
if $Net::FullAuto::FA_Core::debug;
last if -1<index $lyne,'exit';
last if -1<index $lyne,'Exit status';
}
};
}
if ($@) {
print "localhost_end_error=$@\n"
if $Net::FullAuto::FA_Core::debug;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=&kill($localhost->{_sh_pid},$kill_arg)
if &testpid($localhost->{_sh_pid});
if (&testpid($localhost->{_cmd_pid})) {
$localhost->{_cmd_handle}->print("\003");
$localhost->{_cmd_handle}->print("\004");
($stdout,$stderr)=&kill($localhost->{_cmd_pid},$kill_arg);
}
}
if (defined $master_hostlabel &&
(-1<index $localhost,'=')) {
$username=&Net::FullAuto::FA_Core::username();
&scrub_passwd_file($master_hostlabel,
$username);
}
%{$localhost}=();
undef $localhost;
%Processes=();
%Connections=();
@pid_ts=();
if ($Net::FullAuto::FA_Core::makeplan) {
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Plans');
my $plan_number=$Net::FullAuto::FA_Core::makeplan->{'Number'}||'';
my $plan_title =$Net::FullAuto::FA_Core::makeplan->{'Title'}||'';
my $put_plan=Data::Dump::Streamer::Dump(
$Net::FullAuto::FA_Core::makeplan)->Out();
if ($plan_number) {
my $pregx=qr/\]quit\[|INT|ERROR/;
unless ($Net::FullAuto::FA_Core::plan_ignore_error) {
$pregx=qr/\]quit\[|INT/;
}
unless ($param_two=~/$pregx/) {
my $status=$bdb->db_put($plan_number,$put_plan);
print "\n\n ################ NEW PLAN ##################\n\n",
" Number: $plan_number\n",
" Title: $plan_title\n\n",
" WAS SUCCESSFULLY CREATED!\n";
}
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
my $ps=$Net::FullAuto::FA_Core::gbp->('ps').'ps -ef';
my ($psout,$pserr)=Net::FullAuto::FA_Core::cmd($ps);
if ($pserr=~/password[: ]+$/si) {
$psout=`$ps 2>&1`;
}
my %pid=();my %ppid=();
foreach my $line (split "\n", $psout) {
next if $line=~/\/ps$/;
$line=~/^I*\s*[^ ]+\s+(\d+)\s+(\d+).*$/;
my $pid=$1||0;my $ppid=$2||0;
$pid{$pid}=$ppid;
push @{$ppid{$ppid}},$pid;
}
#my $family=find_kids($$,[],\%ppid);
#foreach my $member (@{$family}) {
# ($stdout,$stderr)=&kill($member,$kill_arg)
# if &testpid($member);
#}
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";
} ReadMode 0;
print $Net::FullAuto::FA_Core::LOG
"INFO: GOING TO CLOSE LOG\n"
if -1<index $Net::FullAuto::FA_Core::LOG,'*';
$LOG||='';
CORE::close($LOG) if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$LOG='';
$Hosts{"__Master_${$}__"}{'LogFile'}||='';
print "\n LOGFILE ==> \"",
$Hosts{"__Master_${$}__"}{'LogFile'},"\"\n\n\n"
if $Net::FullAuto::FA_Core::log &&
!($Net::FullAuto::FA_Core::quiet ||
$Net::FullAuto::FA_Core::cron);
my $c=($^O ne 'MSWin32' && $^O ne 'MSWin64' && !exists
$ENV{PAR_TEMP})?'©':'(C)';
print "FullAuto$c COMPLETED SUCCESSFULLY on ".localtime()."\n"
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
if (!$Net::FullAuto::FA_Core::log
&& exists $Hosts{"__Master_${$}__"}{'LogFile'}
&& $Hosts{"__Master_${$}__"}{'LogFile'}) {
unlink $Hosts{"__Master_${$}__"}{'LogFile'};
}
return 1 if $param_one eq '__return__';
exit 1 if $param_one;
exit 0;
};
# Handle INT SIGNAL interruption
$SIG{ INT } = sub{
print "\n\nCAUGHT AN INTERUPT SIGNAL!!\n";
print $Net::FullAuto::FA_Core::LOG
"\n\n=============================",
"\n==== INTERUPT SIGNAL ====",
"\n=============================\n\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
unlink $ENV{FA_ACQUIRING_BERKELEY_DB_LOCK}
if exists $ENV{FA_ACQUIRING_BERKELEY_DB_LOCK};
&release_fa_lock(6543);
$cleanup=1;&cleanup('','INT') };
our $alarm_sounded=0;
$SIG{ ALRM } = sub{ open(AL,">>ALRM.txt");
print AL scalar(localtime()),"\n";
print AL "CAUGHT AN ALRM FROM: ",caller,"\n";
close AL;
$alarm_sounded=1;
print "CAUGHT AN ALRM!! FROM ",caller,"\n";
$cleanup=1;&cleanup('','ALRM') };
$SIG{ CHLD } = 'DEFAULT';
my @Hosts=@{&check_Hosts($Net::FullAuto::FA_Core::fa_host)};
sub username
{
eval {
die;
};
my $path=$@;
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;
$path=~s/\s*$//s;
eval {
require "${path}fa_global.pm";
my $mod="fa_global";
import $mod;
};
$username=getlogin || getpwuid($<);
$username=$Net::FullAuto::FA_Core::usrname if
defined $Net::FullAuto::FA_Core::usrname
&& $Net::FullAuto::FA_Core::usrname;
$username=$Net::FullAuto::fa_global::FA_Sudo{$username}
if exists $Net::FullAuto::fa_global::FA_Sudo{$username};
if (wantarray && !$@) {
my $force_login=0;
if (defined $Net::FullAuto::fa_global::FA_Force_Login &&
$Net::FullAuto::fa_global::FA_Force_Login) {
$force_login=$Net::FullAuto::fa_global::FA_Force_Login;
} elsif (defined $fa_conf::fa_force_login &&
$fa_conf::fa_force_login) {
$force_login=$fa_conf::fa_force_login;
} elsif (defined $fa_conf::force_login &&
$fa_conf::force_login) {
$force_login=$fa_conf::force_login;
}
$force_login||=0;
return $username, $force_login;
} elsif (wantarray) {
return $username, 0;
}
return $username;
}
sub grep_for_string_existence_only
{
my $file=$_[0];
my $pattern=$_[1];
my $return_value=0;
eval {
open(FH,"<$file") || return 0;
my $keygen_flag=0;
while (my $line=<FH>) {
if ($line=~/^\[localhost\]/) {
$return_value=1;
last;
} elsif ($line=~/^\|?\[?(?:1|localhost)\]?\|?|ssh-rsa|ecdsa-sha2/s) {
$keygen_flag=1;
last;
} elsif ($line=~/$pattern/) {
$return_value=1;
last;
}
}
if ($keygen_flag) {
my ($stdout,$stderr)=('','');
my $output=`ssh-keygen -F localhost 2>&1`;
$return_value=1 if (-1<index $output,'localhost')
|| (-1<index $output,'illegal option -- F');
}
};
return $return_value;
}
sub fetch
{
my $self=$_[0];my $output='';my $select_timeout=2;my $ready='';
if (select $ready=${${*{$self->{_cmd_handle}}}{'net_telnet'}}{'fdmask'},
'', '', $select_timeout) {
alarm($select_timeout+10);
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
sysread $self->{_cmd_handle},$output,
${${*{$self->{_cmd_handle}}}{net_telnet}}{blksize},0;
};alarm(0);
if ($@ eq "alarm\n") {
$self->{_cmd_handle}->print();
}
return $output;
#alarm($select_timeout+10);
#sysread $self->{_cmd_handle},$output,
# ${${*{$self->{_cmd_handle}}}{net_telnet}}{blksize},0;
#alarm(0);
#return $output;
} return ' ';
}
sub cmd_raw
{
my $handle=$_[0];
my $cmd=$_[1];
my $display=(grep { /__display__/ } @_)?1:0;
$handle->{_cmd_handle}->print($cmd);
my $prompt=substr($handle->{_cmd_handle}->prompt(),1,-1);
my $alloutput='';
while (1) {
my $output.=Net::FullAuto::FA_Core::fetch($handle);
$alloutput.=$output;
last if $output=~/$prompt/;
print $output if $display;
}
return $alloutput;
}
sub version
{
can_load(modules => { "Net::FullAuto" => 0 });
my $version=<<VERSION;
This is Net::FullAuto©, v$Net::FullAuto::VERSION
(See fullauto -V or fa -V for more detail)
Copyright © 2000-2015, Brian M. Kelly Brian.Kelly\@FullAuto.com
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.FullAuto.com/, the
FullAuto© Home Page.
FullAuto© uses the Crypt::DES module which is software developed by
Systemics Ltd (http://www.systemics.com/)
FullAuto uses the Net::SSLeay module which is software developed by the
OpenSSL Project for use in the OpenSSL Toolkit. (http://www.openssl.org/)
and includes cryptographic software written by Eric Young (eay\@cryptsoft.com)
and Tim Hudson (tjh\@cryptsoft.com)
VERSION
print $version;
exit;
}
sub users
{
can_load(modules => { "Term::Menus" => 0 });
can_load(modules => { "Net::FullAuto" => 0 });
my $username=&Net::FullAuto::FA_Core::username();
my $term_menus_path=
substr($INC{'Term/Menus.pm'},0,
(rindex $INC{'Term/Menus.pm'},'Term'));
my $net_fulla_path=
substr($INC{'Net/FullAuto.pm'},0,
(rindex $INC{'Net/FullAuto.pm'},'Net'));
$term_menus_path=~s/\/share\//\/lib\//
if -1<index $term_menus_path,'share';
my $o='';
foreach my $p (@INC) {
$o=$p;
last if -1<index $o,$term_menus_path;
last if "$o/" eq $term_menus_path;
}
my @tmlist=();
if (-f $o.'/auto/Term/Menus/.packlist') {
open (TH,"<$o/auto/Term/Menus/.packlist");
while (my $f=<TH>) {
chomp $f;
push @tmlist,$f;
}
close(TH);
}
my @falist=();
if (-f $o.'/auto/Net/FullAuto/.packlist') {
open (PH,"<$o/auto/Net/FullAuto/.packlist");
@falist=<PH>;
close(PH);
}
my $checkpath='';
foreach my $file (@falist) {
if (-1<index $file,'Net/FullAuto/Custom') {
$checkpath=substr($file,0,(index $file,'Net/FullAuto/Custom')+19);
last;
}
}
my $output=`ls -l $checkpath 2>&1`;
my ($size,$timestampd,$dirname)=('','','');
my @users=();
my $nl=0;
foreach my $line (split "\n", $output) {
print "\n" if $nl==1;
next unless $line=~/^d/;
($size,$timestampd,$dirname)=&Net::FullAuto::FA_Core::ls_parse($line);
next if $dirname eq 'BackUp';
$nl=1;
print $dirname;
}
print "\n" unless $^O eq 'cygwin';
exit;
}
sub figlet
{
can_load(modules => { "Term::Menus" => 0 });
can_load(modules => { "Net::FullAuto" => 0 });
my $figlet='';my @figletfonts=();
if ($figlet=$Net::FullAuto::FA_Core::gbp->('figlet')) {
my $path=`$figlet/figlet -I2`;
chomp $path;
opendir(my $dh, $path) || die "can't opendir $path: $!";
while (my $file=readdir($dh)) {
chomp($file);
next unless $file=~s/.flf$//;
push @figletfonts,$file;
}
my $figban=`$figlet/figlet -f small "FIGlet Fonts"`;
$figban=~s/^/ /mg;
$figban="\n\n$figban ".
"Choose a FIGlet Font (by number) to preview with text \"Example\"".
"\n -OR- continuously scroll and view by repeatedly pressing ENTER".
"\n\n HINT: Typing !figlet -f<fontname> YOUR TEXT\n\n".
" is another way to preview the font of your choice.\n\n";
$main::figletoutput=sub {
return `figlet -f ]P[{figmenu} $_[0]`;
};
my $figlet_banner=<<END;
]O[{1,'figletoutput'}
]P[{figmenu} font
]I[{1,'Example',40}
The box above is an input box. The [DEL] key will clear the contents.
Type anything you like, and it will appear in the ]P[{figmenu} FIGlet font!
END
my %figletoutput=(
Name => 'figletoutput',
Result => sub { return '{figmenu}<' },
Input => 1,
Banner => $figlet_banner,
);
my %figmenu=(
Name => 'figmenu',
Item_1 => {
Text => ']C[',
Convey => \@figletfonts,
Result => \%figletoutput,
},
Display => 8,
Scroll => 1,
Banner => $figban,
);
my $selection=Menu(\%figmenu);
} else {
print STDERR "\n FATAL ERROR: FullAuto cannot locate",
" the program 'figlet' on this host.\n\n";
}
exit;
}
sub tutorial
{
can_load(modules => { "Term::Menus" => 0 });
can_load(modules => { "Net::FullAuto" => 0 });
my $username=&Net::FullAuto::FA_Core::username();
print "USERNAME=$username\n";
exit;
}
sub VERSION
{
can_load(modules => { "Term::Menus" => 0 });
can_load(modules => { "Net::FullAuto" => 0 });
my $username=&Net::FullAuto::FA_Core::username();
my $term_menus_path=
substr($INC{'Term/Menus.pm'},0,
(rindex $INC{'Term/Menus.pm'},'Term'));
my $net_fulla_path=
substr($INC{'Net/FullAuto.pm'},0,
(rindex $INC{'Net/FullAuto.pm'},'Net'));
$term_menus_path=~s/\/share\//\/lib\//
if -1<index $term_menus_path,'share';
my $o='';my @tmlist=();my @falist=();
foreach my $p (@INC) {
$o=$p;
if (-f $o.'/auto/Term/Menus/.packlist') {
open (TH,"<$o/auto/Term/Menus/.packlist");
while (my $f=<TH>) {
chomp $f;
push @tmlist,$f;
}
close(TH);
open (PH,"<$o/auto/Net/FullAuto/.packlist");
@falist=<PH>;
close(PH);
last;
}
}
my @pl=();my @exe=();my @O=();my %Cust=();my @Dist=();
my @Tpm=();my @html=();my @Core=();my @README=();my @CUF=();
foreach my $file (@falist) {
chomp $file;
if ($file=~/\.pm$/) {
if (-1<index $file,'Distro') {
push @Dist, $file;next;
} elsif (-1<index $file,'Custom') {
$Cust{$file}='';next;
} else {
push @Core, $file;
my $path=$file;
$path=~s/^(.*)\/.*$/$1/;
push @Core, "$path/fa_global.pm" if
-e "$path/fa_global.pm";
next
}
} elsif ($file=~/\.pl$/) {
push @pl, $file;next;
} elsif ($file=~/fullauto(?:\.exe)*$/) {
push @exe, $file;next;
} elsif ($file=~/1$/) {
push @O, $file;next;
} elsif ($file=~/html$/) {
push @html, $file;next;
} elsif ($file=~/3pm/) {
push @Tpm, $file;next;
} elsif (-1<index $file,'README') {
if (-1<index $file,'Custom/README') {
my $path=$file;
$path=~s/\/[^\/]+$//;
opendir(my $dh, $path) || die "can't opendir $path: $!";
while (my $file=readdir($dh)) {
chomp($file);
next if $file eq '.';
next if $file eq '..';
$Cust{"$path/$file"}='' if $file!~/^[.]|README$/
&& -f "$path/$file";
if (-d "$path/$file" && ($file eq $username)) {
opendir(my $dc, "$path/$file") ||
die "can't opendir $path/$file: $!";
while (my $cfile=readdir($dc)) {
chomp($cfile);
next if $cfile eq '.';
next if $cfile eq '..';
if (-d "$path/$file/$cfile") {
opendir(my $du, "$path/$file/$cfile") ||
die "can't opendir $path/$file/$cfile: $!";
while (my $ufile=readdir($du)) {
chomp($ufile);
next if $ufile eq '.';
next if $ufile eq '..';
push @CUF,"$path/$file/$cfile/$ufile";
} close $du;
}
} close $dc;
}
} closedir $dh;
}
push @README, $file;
}
}
print "\nTerm::Menus Version $Term::Menus::VERSION\n",
(join "\n",@tmlist),"\n\n",
"Net::FullAuto Version $Net::FullAuto::VERSION\n",
(join "\n",@pl),"\n",
(join "\n",@exe),"\n\n";
print '',(join "\n",@O),"\n" if -1<$#O;
print '',(join "\n",@Tpm),"\n",
(join "\n",@html),"\n",
(join "\n",@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";
exit;
}
sub pick
{
return &Menus::pick(@_);
}
sub Menu
{
can_load(modules => { "Term::Menus" => 0 });
return &Term::Menus::Menu(@_);
}
sub get_today
{
my @what=split / +/, scalar localtime(time);
my $day=$days{$what[0]};
my $month=$fullmonth{$what[1]};
my $what="$day, $month $what[2], $what[4]";
return $what;
}
sub get_tomorrow
{
my $t=time+86400;
my @what=split / +/, scalar localtime($t);
my $day=$days{$what[0]};
my $month=$fullmonth{$what[1]};
my $what="$day, $month $what[2], $what[4]";
return $what;
}
sub get_now_am_pm
{
my $time=$_[0]||time;
my $t=unpack('a5',(split / +/, scalar localtime($time))[3]);
my $i=unpack('a2',$t);
if ($i<12) {
substr($t,0,1)='' if $i<10;
return $t.'am';
} elsif ($i==12) {
return $t.'pm';
} else {
substr($t,0,2)=unpack('a2',$t)-12;
return $t.'pm';
}
}
sub ls_parse
{
my $line=$_[0];my $size='';my $file='';
my $mn='';my $dy='';my $time=0;my $fileyr='';
my $rx1=qr/[\d|\.]+[KMG]?\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/[\d|\.]+[KMG]?\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;
if ($line=~s/^.*\s+($rx1|$rx2)$/$1/) {
$line=~/^([\d|\.]+[KMG]?)\s+(\w\w\w)\s+(\d+)\s+(\d\d:\d\d\s+|\d\d\d\d\s+)(.*)$/;
$size=$1;$mn=$Net::FullAuto::FA_Core::month{$2};$dy=$3;$time=$4;
$file=$5;
}
my $hr=12;my $mt='00';
if (length $time==4) {
$fileyr=$time;
} elsif ($time) {
($hr,$mt)=unpack('a2 @3 a2',$time);
my $yr=unpack('x1 a2',$Net::FullAuto::FA_Core::thisyear);
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
}
}
} else { return 0,0,'' }
return $size, timelocal(0,$mt,$hr,$dy,$mn-1,$fileyr), $file;
}
sub find_berkeleydb_utils {
my @topcaller=caller;
my $hlab="localhost - ".hostname;
print "\nINFO: main::find_berkeleydb_recover() (((((((CALLER))))))) ".
"for HostLabel $hlab:\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
my $db_util=$_[0];
my $berkeleydb_perl_module_lib='';
can_load(modules => { "BerkeleyDB" => 0 });
my $berkeleydb_path=$INC{'BerkeleyDB.pm'};
$berkeleydb_perl_module_lib=$berkeleydb_path;
$berkeleydb_perl_module_lib=~s/\/Berkeley/\/auto\/BerkeleyDB\/Berkeley/;
my $ext=($^O eq 'cygwin')?'dll':'so';
$berkeleydb_perl_module_lib=~s/pm$/$ext/;
my $bcmd=$Net::FullAuto::FA_Core::gbp->('strings').'strings '.
"$berkeleydb_perl_module_lib | ".
$Net::FullAuto::FA_Core::gbp->('grep')."grep \"Berkeley ?DB.*:\"";
my $bver=`$bcmd`;
$bver=~s/^.*?DB\s+(.*?)\.\d+:.*$/$1/s;
my $mr="__Master_".$$."__";
unless (exists $Hosts{$mr}) {
$mr="__Master_".getppid."__";
}
if ($^O eq 'cygwin' && -f "/bin/db${bver}_$db_util.exe") {
return "/bin/db${bver}_$db_util.exe";
} 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;
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;
}
} elsif (-d $fa_conf::berkeleydb.'/include') {
if (-f $fa_conf::berkeleydb.'/include/db.h') {
my $dbh=$fa_conf::berkeleydb.'/include/db.h';
open(FH,"<$fa_conf::berkeleydb/include/db.h")
or &handle_error(
"Cannot open $fa_conf::berkeleydb/include/db.h");
my @finc=<FH>;
close(FH);
foreach my $line (@finc) {
if ($line=~/^.*VERSION.*$bver.*$/) {
if (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_'.$db_util;
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;
}
}
}
&handle_error("Cannot Locate BerkeleyDB installation");
} elsif (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_'.$db_util;
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;
} else {
&handle_error("Cannot Locate BerkeleyDB db_$db_util utility");
}
} elsif (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_'.$db_util;
} elsif (-f $fa_conf::berkeleydb.'/db_'.$db_util) {
return $fa_conf::berkeleydb.'/db_'.$db_util;
} elsif ($^O eq 'cygwin' && (-f "/bin/db${bver}_$db_util.exe")) {
return "/bin/db${bver}_$db_util.exe";
} else {
&handle_error("Cannot Locate BerkeleyDB db_$db_util utility");
}
} else {
my @output=();
my $greppath=$Net::FullAuto::FA_Core::gbp->('grep');
my $testgrep =`${greppath}grep -H 2>&1`;
my $testgrep2=`${greppath}grep 2>&1`;
my $grepopt='';
if ((-1==index $testgrep,'illegal option')
&& (-1==index $testgrep2,'-insvxbhwyu')) {
$grepopt='-H ';
}
my $find_cmd1=$Net::FullAuto::FA_Core::gbp->('find')."find ";
my $find_cmd2=" -name \"*.h\" ".
"| ".$Net::FullAuto::FA_Core::gbp->('xargs')."xargs ".
$greppath."grep ".
"${grepopt}DB_VERSION_STRING";
print "\nSearching for latest verison of BerkeleyDB.\n".
"This may take up to five minutes ...\n\n";
foreach my $dir ('/usr/local/',
'/usr/','/opt/',(getpwuid $>)[7].'/') {
next if unpack('a1',$dir) eq '.';
next unless -d $dir;
opendir(DIR, $dir) or die $!;
while (my $file = readdir(DIR) ) {
next if ($file eq "." or $file eq ".." or $file eq "doc" or
$file eq "X11R6" or $file eq "docs" or
$file eq "man" or $file eq "ssl" or
$file eq "license" or $file eq "logfile" or
$file eq "bin" or ($^O eq 'cygwin' &&
($file eq "Application Data" or
$file eq "Favorites" or $file eq
"Local Settings" or $file eq "Recent" or
$file eq "Start Menu" or $file eq "SendTo" or
$file eq "NetHood" or $file eq "PrintHood")));
if (-d $dir.$file) {
print "Searching $dir$file ...\n";
my @subout=`$find_cmd1\"$dir$file\"$find_cmd2`;
if (-1<$#subout) {
eval {
our %Config=();
require Config;
import Config;
if (!(-e "$ENV{HOME}/.cpan/CPAN/MyConfig.pm") || (!old_cpan() && -e $^X)) {
my $run_cpan="echo y | $^X -e \"require CPAN;".
'require CPAN::FirstTime;'.
'*{CPAN::FirstTime::_using_sudo} = sub { return 1 };'.
"CPAN::FirstTime::init(\'$Config{privlib}\');\" 2>&1";
system($run_cpan);
$run_cpan="echo yes | /usr/bin/perl -e \"require CPAN;".
"CPAN::Shell->o('conf','init','auto_commit')\"";
system($run_cpan);
$run_cpan="CPAN::Shell->o('conf','urllist','http://www.cpan.org')";
system($run_cpan);
}
require CPAN;
import CPAN;
CPAN::HandleConfig->load;
};
&handle_error($@) if $@;
my $ccon=(defined $CPAN::Config &&
exists $CPAN::Config->{cpan_home})?
$CPAN::Config->{cpan_home}:'';
my @vers=();my %verhash=();
foreach my $version (@subout) {
next if (-1<index $version, $ccon) ||
(-1<index $version, 'Net-FullAuto-') ||
$version!~/db.h:.*DB_VERSION_STRING/;
my @fileparts=split 'db.h:', $version;
$fileparts[1]=~s/^.*DB (\d+[^:]+):.*$/$1/;
if (-1<index $fileparts[1], $bver) {
my $bintest=$subout[0];
substr($bintest,(rindex $bintest,'include'))='bin';
$berkeleydb=substr($bintest,0,-4)
if -d $bintest;
}
}
}
}
last if $berkeleydb;
} last if $berkeleydb;
}
$berkeleydb||='';
if ($berkeleydb) {
print "MR=$mr and THIS=$Net::FullAuto::FA_Core::fa_conf\n";
my $fconf=$Hosts{$mr}{'FA_Core'}.'Custom/'.
$Net::FullAuto::FA_Core::fa_conf;
open(CH,"+<$fconf") or &handle_error("Cannot open $fconf");
flock CH, 2;
my @data=<CH>;
my $bd=0;my @new=();
foreach my $ln (@data) {
if (($bd==0) && ($ln=~/^\s*[#]*\s*our\s+[\$]berkeleydb\s*=/)) {
push @new, "our \$berkeleydb = \"$berkeleydb\";\n";
$bd=1;
} else {
push @new, $ln;
}
}
unless ($bd) {
@new=();
foreach my $ln (@data) {
my $l=$ln;
if (($bd==0) &&
($l=~/^\s*[#]*\s*our\s+(?!ISA|VERSION|EXPORT)/)) {
push @new, "our \$berkeleydb = \"".
$berkeleydb."\";\n";
push @new, $ln;
$bd=1;
} else {
push @new, $ln;
}
}
}
seek CH, 0, 0;
truncate CH, 0;
print CH @new;
close CH;
}
return $berkeleydb.'/bin/db_'.$db_util;
}
}
sub cat {
eval {
die;
};
my $path=$@;
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;
$username=&Net::FullAuto::FA_Core::username();
chomp($path);
my $cpath=$path."Custom/$username/";
my $arg=$_[0];
if (-e $arg) {
if (-r $arg) {
if ($arg=~/^$cpath/) {
open (FH,"<$arg") ||
(print STDERR "\n\n FullAuto cannot open $arg $!\n\n"
&& exit 1);
my $file='';
while (my $line=<FH>) {
$file.=$line;
}
close(FH);
print $file;
} else {
print STDERR "\n FATAL ERROR: The user $username is not",
" authorized to view - \n\n $arg\n\n";
}
} else {
print STDERR "\n FATAL ERROR: FullAuto cannot read",
" - \n\n $arg\n\n";
}
} else {
print STDERR "\n FATAL ERROR:\n\n $arg\n\n DOES NOT EXIST\n\n";
}
exit;
}
sub edit {
eval {
die;
};
my $path=$@;
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;
my $username=&Net::FullAuto::FA_Core::username();
chomp($path);
my $cpath=$path."Custom/$username/";
my $tpath=$path;
$tpath=~s/Net.*//;
our $fa_code='';
our $fa_conf='';
our $fa_host='';
our $fa_menu='';
require Term::Menus;
if (defined $Term::Menus::fa_conf) {
$fa_conf=$Term::Menus::fa_conf;
if (-d $tpath.'Net/FullAuto/Custom/'.$username) {
eval {
require $fa_conf->[0];
my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3);
import $mod;
$fa_conf=$mod.'.pm';
};
if ($@) {
warn "ERROR=$@\n";
}
}
}
if (defined $Term::Menus::fa_code) {
$fa_code=substr($Term::Menus::fa_code->[0],
(rindex $Term::Menus::fa_code->[0],'/')+1);
}
if (defined $Term::Menus::fa_host) {
$fa_host=substr($Term::Menus::fa_host->[0],
(rindex $Term::Menus::fa_host->[0],'/')+1);
}
if (defined $Term::Menus::fa_menu) {
$fa_menu=substr($Term::Menus::fa_menu->[0],
(rindex $Term::Menus::fa_menu->[0],'/')+1);
}
my $editor='';
$fa_conf::editor||='';
unless ($editor=$fa_conf::editor) {
if ($^O eq 'cygwin') {
my $mount=`/bin/mount -p`;
$mount=~s/^.*(\/\S+).*$/$1/s;
if (!$ENV{SSH_TTY} && -e $mount.
'/c/Program Files/Windows NT/Accessories/wordpad.exe') {
$editor=$mount.
'/c/Program Files/Windows NT/Accessories/wordpad.exe';
} elsif (-e '/bin/vim.exe') {
$editor='/bin/vim.exe';
}
} else {
if (-e '/usr/bin/vi') {
$editor='/usr/bin/vi';
} elsif (-e '/bin/vi') {
$editor='/bin/vi';
} elsif (-e '/usr/bin/emacs') {
$editor='/usr/bin/emacs';
}
}
}
my $savdir=Cwd::cwd();
if ($_[0]=~/ho*s*t*|^fa_host$/i) {
$cpath.='Host';
system("cd $cpath;\"$editor\" ".
"$fa_host;cd \"$savdir\"");
} elsif ($_[0]=~/^m$|^me$|^men$|^menu$|^fa_menu$/i) {
$cpath.='Menu';
$fa_menu=~s/^(fa_.*)_demo(.pm)$/$1$2/
unless -f "$cpath./$fa_menu";
system("cd $cpath;\"$editor\" ".
"$fa_menu;cd \"$savdir\"");
} elsif ($_[0]=~/^c$|^co$|^cod$|^code$|^fa_code$/i) {
$cpath.='Code';
$fa_code=~s/^(fa_.*)_demo(.pm)$/$1$2/
unless -f "$cpath./$fa_code";
system("cd $cpath;\"$editor\" ".
"$fa_code;cd \"$savdir\"");
} elsif ($_[0]=~/con*f*|^fa_conf$/i) {
$cpath.='Conf';
system("cd $cpath;\"$editor\" ".
"$fa_conf;cd \"$savdir\"");
} elsif ($_[0]=~/f/) {
system("cd $path;\"$editor\" FA_Core.pm;cd \"$savdir\"");
} elsif ($_[0]=~/r/) {
system("cd ${tpath}Term;\"$editor\" RawInput.pm;cd \"$savdir\"");
} elsif ($_[0]=~/t/) {
system("cd ${tpath}Term;\"$editor\" Menus.pm;cd \"$savdir\"");
} else {
my $stderr='';my $stdout='';
chdir $cpath;
($stdout,$stderr)=cmd($Net::FullAuto::FA_Core::gbp->('ls')."ls -lR");
die $stderr if $stderr;
my @files=split "\n", $stdout;
my @file=();my $dirr='';
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;
foreach my $file (@files) {
next if $file=~/^\s*$/;
next if unpack('a1',$file) eq 'd';
next if $file=~/^total/;
next if $file eq '.:';
if (unpack('a2',$file) eq './') {
$dirr=unpack('x2a*',$file);
chop($dirr);
next;
}
chomp($file);
next if $file=~/\/$/;
next if $file eq 'README';
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/;
}
push @file,$username.'/'.$dirr.'/'.$file;
}
my $owner=getpwuid(${stat($path)}[4]);
if ($owner eq $username) {
($stdout,$stderr)=cmd($Net::FullAuto::FA_Core::gbp->('ls').
"ls -1 ..");
die $stderr if $stderr;
foreach my $file (split "\n", $stdout) {
push @file, "Template $file" if $file=~/[.]pm$/;
}
push @file, "Global Settings fa_global.pm";
}
my %Menu_1=(
Item_1 => {
Text => "]C[",
Convey => \@file,
},
Select => 'One',
Banner => "\n Choose a File to Edit:\n\n"
);
my $file=Menu(\%Menu_1);
if ($file eq ']quit[') {
print "\n";
exit;
}
chdir '..';
$file=~s/^Template (.*)/$1/;
chdir '..' if $file=~s/^Global Settings (.*)/$1/;
system("\"$editor\" $file");
chdir $savdir;
}
exit;
}
my $today=unpack('x2a2',$invoked[7]);
my $curmonth=unpack('a2',$invoked[7]);
my $fullmonth=$month[$curmonth-1];
$fullmonth=~s/\s*$//;
my $todays_date="$fullmonth $today, $curyear";
my $endyear=$curyear + 20;
my $lastday='';
my $showmins=sub { package showmins;
my $datechosen=']P[{select_cal_days}';
$datechosen=~s/^"//;
$datechosen=~s/"$//;
$datechosen=~s/^(?:Today|Tomorrow) - //;
$datechosen=~s/^[A-Za-z]+, //;
my @hrmn=();
if ($datechosen eq $todays_date) {
my $now=unpack('a2',(split ':',
&Net::FullAuto::FA_Core::get_now_am_pm)[1]);
$now++;
foreach my $hr (@hours[$invoked[4]..23]) {
foreach my $mn ($now..59) {
if (length $mn==1) {
$mn='0'.$mn;
}
push @hrmn, unpack('a3',$hr).$mn.unpack('x5a2',$hr);
} $now=0;
} return @hrmn;
} else {
foreach my $hr (@hours[0..23]) {
foreach my $mn (0..59) {
if (length $mn==1) {
$mn='0'.$mn;
}
push @hrmn, unpack('a3',$hr).$mn.unpack('x5a2',$hr);
}
} return @hrmn;
}
};
my $hours=sub { package hours;
my $date_chosen=']P[';
$date_chosen=~s/^"//;
$date_chosen=~s/"$//;
$date_chosen=~s/^(?:Today|Tomorrow) - //;
$date_chosen=~s/^[A-Za-z]+, //;
if ($date_chosen eq $todays_date) {
my $in=$invoked[4]+1;
return (@hours[$in..23])
} else { return @hours } };
my $cal_months=sub { package cal_months;
my $yr=']P[';
my $yrs=']P[{calendar_years}';
$yr=$yrs if -1==index $yrs,'calendar_years';
my @munths=();
my $cmonth=$curmonth-1;
if ($curyear==$yr) {
if ($curmonth==12) {
@munths=$month[11];
} else {
@munths=@month[$cmonth..11];
}
} else {
@munths=@month;
}
my @new=map { $_.' '.$yr } @munths;
return @new };
my $fulldays=sub { package fulldays;
my ($a,$b)=('','');
my $p=']P[';
$p=~s/^"//;
$p=~s/"$//;
($a,$b)=split / +/, $p;
my $c=pack('A9',$a);
my @n=();
my $s=1;
$s=$today if $b eq $Net::FullAuto::FA_Core::curyear &&
-1<index $month[$curmonth-1],$a;
my $currmonth=$curmonth;my %mdates=();
foreach my $year ($curyear..$endyear) {
my $cnt=0;
if ($year ne $curyear) {
$currmonth=1;
} else {
$cnt=$currmonth-1;
}
foreach my $mth ($currmonth..12) {
$lastday=POSIX::mktime(0,0,0,0,
$mth-1+1,$year-1900,0,0,-1);
my $d=localtime($lastday);
my @d=split ' ',$d;
$mdates{$year}{$month[$cnt++]}=$d[2];
}
}
foreach my $d ($s..$mdates{$b}{$c}) {
$d='0'.$d if length $d==1;
push @n, $a.' '.$d.', '.$b;
}
return @n };
my $track='';
my %show_mins=(
Name => 'show_mins',
Item_1=> {
Text => "]C[",
Convey => $showmins,
Result => sub{ my $previous_selection=']P[{select_cal_days}';
my $s=']s[';
$s=~s/^"//;$s=~s/"$//;
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 :\n\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[';
$previous_selection=~s/^"//;
$previous_selection=~s/"$//;
return $previous_selection." ".']S[' }
},
Scroll=>2,
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Password Expiration Time :\n\n",
);
my %select_cal_days=(
Name => 'select_cal_days',
Item_1=> {
Text => "]C[",
Convey => $fulldays,
Result => \%select_hour,
},
Scroll=>1,
Banner=> " Please Select a Password Expiration Date :\n\n",
);
my %select_cal_months=(
Name => 'select_cal_months',
Item_1=> {
Text => "]C[",
Convey => $cal_months,
Result => \%select_cal_days,
},
Scroll=>3,
Banner=> " Please Select a Month :\n\n",
);
my %calendar_years=(
Name => 'calendar_years',
Item_1=> {
Text => "]C[",
Convey => [$curyear..$endyear],
Result => \%select_cal_months,
},
Scroll=>1,
Banner=> " Please Select a Year :\n\n"
);
my $select_time_result_sub = sub {
package select_time_result_sub;
use Net::FullAuto::FA_Core qw/%month timelocal/;
my $selection="]S[{select_minutes|select_hours|".
"select_days|select_weeks|select_months}";
$selection=~s/^["]//;
$selection=~s/["]$//;
my ($num,$type)=('','');
my $expires=0;
no strict 'subs';
use BerkeleyDB;
use File::Path;
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);
my $progname=substr($0,(rindex $0,'/')+1,-3);
require "$loc/fa_global.pm";
my $mkdflag=0;
($num,$type)=split /\s+/, $selection;
if ($num!~/^\d/) {
my @d=split /,* +/, $selection;
my $mn=unpack('a3',$d[0]);
if (defined $d[3] && $d[3]) {
my $ap=substr($d[3],-2);
my ($h,$m)=('','');
($h,$m)=split ':',substr($d[3],0,-2);
$h+=12 if $ap eq 'pm' && $h!=12;
my $mon=$month{$mn} if $mn && exists $month{$mn};
$mon||=1;
my $day=$d[1] if defined $d[1] && $d[1];
$day||=1;
$expires=&Net::FullAuto::FA_Core::timelocal(
0,$m,$h,$day,$mon-1,$d[2]);
} else {
my $mon=$month{$mn} if $mn && exists $month{$mn};
$mon||=1;
my $day=$d[1] if defined $d[1] && $d[1];
$day||=1;
$expires=&Net::FullAuto::FA_Core::timelocal(
0,0,0,$day,$mon-1,$d[2]);
}
} elsif ($type=~/Min/) {
$expires=time + $num * 60;
} elsif ($type=~/Hour/) {
$expires=time + $num * 3600;
} elsif ($type=~/Day/) {
$expires=time + $num * 86400;
} elsif ($type=~/Week/) {
$expires=time + $num * 604800;
} elsif ($type=~/Month/) {
$expires=time + $num * 2592000;
}
my $previous="]!P[{existing_plans}";
if ($previous=~/[]]!P[[][{]existing_plans[}]/) {
return $expires;
} else {
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Plans');
my $cursor=$bdb->db_cursor();
my ($k,$v)=('','');
my $planhash={};
my $plan_number=$previous;
$plan_number=~s/^.*:\s+(\d+)\s+.*$/$1/;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
#print "WHAT IS K=$k<== and PLAN=$plan_number\n";
if ($k eq $plan_number) {
$v=~s/\$HASH\d*\s*=\s*//s;
$planhash=eval $v;
$planhash->{'Title'}||='';
last;
}
}
undef $cursor;
$planhash->{'Expires'}=$expires;
my $put_plan=Data::Dump::Streamer::Dump($planhash)->Out();
my $status=$bdb->db_put($plan_number,$put_plan);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return '{activate_or_disable_expiration}<';
}
};
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 :\n\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,
},
Scroll => 2,
Banner => " Choose Time :\n\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 :\n\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 :\n\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,
},
Scroll => 3,
Banner => " Choose Time in Months (A Month is 30 Days)\n\n".
" [Hint: Use FULL CALENDAR for more precision]:\n\n",
);
my $ask_exp_banner_sub = sub {
my $banner='';
my $caller="]P[";
$caller=~s/^["](.*)["]$/$1/s;
if ($caller eq 'Set New Expiration') {
my $plan=']!P[{existing_plans}';
$plan=~s/^["](.*)["]$/$1/s;
return " Choose the Expiration Time for\n\n".
" $plan\n";
} else {
my $username=&Net::FullAuto::FA_Core::username();
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):\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,
},
Scroll => 3,
Banner => $ask_exp_banner_sub,
);
my $get_expiration_sub=sub {
package get_expiration_sub;
use Net::FullAuto::FA_Core qw/%days @month/;
my $arg=']!P[{existing_plans}';
$arg=~s/^["](.*)["]$/$1/s;
my $plan=&Net::FullAuto::FA_Core::getplan($arg);
my $return="\n Choose an expiration action for\n\n $arg:\n";
if (exists $plan->{Expires} && $plan->{Expires} &&
$plan->{Expires} ne 'never') {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
localtime($plan->{Expires});
my $m=$month[$mon];$m=~s/\s*$//;
$year += 1900;my $xp='--EXPIRED--';
$xp='EXPIRES' if time<$plan->{Expires};
$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";
} else {
$return.="\n -- NO EXPIRATION IS SET --\n";
}
return $return;
};
my $never_expires_sub=sub {
package neverexpires;
my $arg=']!P[{existing_plans}';
$arg=~s/^["](.*)["]$/$1/s;
no strict 'subs';
use BerkeleyDB;
my $plan=&Net::FullAuto::FA_Core::getplan($arg);
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb(
'Plans');
my $cursor=$bdb->db_cursor();
my ($k,$v)=('','');
my $planhash='';
my $plan_number=$arg;
$plan_number=~s/^.*:\s+(\d+)\s+.*$/$1/;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
#print "WHAT IS K=$k<== and PLAN=$plan_number\n";
if ($k eq $plan_number) {
$v=~s/\$HASH\d*\s*=\s*//s;
$planhash=eval $v;
$planhash->{'Title'}||='';
last;
}
}
undef $cursor;
$planhash->{'Expires'}='never';
my $put_plan=Data::Dump::Streamer::Dump($planhash)->Out();
my $status=$bdb->db_put($plan_number,$put_plan);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return '<';
};
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,
);
return \%activate_or_disable_expiration;
};
my $plan_options_sub=sub {
#my $choice=']P[';
#print "\n PLAN=$choice\n";<STDIN>;
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[';
$plan=~s/^["](.*)["]$/$1/s;
return " Choose an operation to perform".
" with\n\n PLAN: $plan"
},
);
return \%plan_options;
};
my $change_existing_plan_sub=sub {
package change_existing_plan_sub;
my $choice="]S[{plan_existing}";
no strict 'subs';
use BerkeleyDB;
my ($plan_number,$planhash,$bdb,$dbenv)=('','','','');
($plan_number,$planhash,$bdb,$dbenv)=
&Net::FullAuto::FA_Core::getplan($choice);
if (-1<index $choice,'Delete') {
my $answer='';
while ($answer!~/^[yY|nN]$/) { last }
my $ch=$choice;
$ch=~s/Delete //s;
$ch=~s/["]//gs;
$ch=~s/\s\s+/ /gs;
print $Net::FullAuto::FA_Core::blanklines;
print "\n Are You Sure You want to DELETE\n\n",
" $ch? (y|N) ";
while ($answer!~/^[yY|nN]$/) {
$answer=<STDIN>;
chomp($answer);
last if $answer=~/^[yY|nN]$/;
}
if ($answer=~/^[yY]$/) {
my $status=$bdb->db_del($plan_number);
}
} elsif (-1<index $choice, 'Rename') {
$planhash->{'Expires'}='never';
print "\n\n\n Type New Name for Plan $plan_number: ";
my $newname=<STDIN>;
chomp($newname);
$planhash->{'Title'}=$newname;
$planhash=Data::Dump::Streamer::Dump($planhash)->Out();
my $status=$bdb->db_put($plan_number,$planhash);
} else {
$planhash->{'Expires'}='never';
print "GOING TO EXPORT\n";
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return '{plan_menu}<';
};
my $plan_existing_sub=sub {
my %plan_existing=(
Name => 'plan_existing',
Item_1 => {
Text => 'Delete Plan: ]C[',
Convey => sub {
my $p=']P[';
$p=~s/^["](.*)["]$/$1/s;
return $p;
},
Result => $change_existing_plan_sub,
},
Item_2 => {
Text => 'Rename Plan: ]C[',
Convey => sub {
my $p=']P[';
$p=~s/^["](.*)["]$/$1/s;
return $p;
},
Result => $change_existing_plan_sub,
},
Item_3 => {
Text => 'Export Plan: ]C[',
Convey => sub {
my $p=']P[';
$p=~s/^["](.*)["]$/$1/s;
return $p;
},
Result => $change_existing_plan_sub,
},
Banner => sub {
my $p=']P[';
$p=~s/^["](.*)["]$/$1/s;
return " Choose an operation to perform".
" with\n\n PLAN: $p"
},
);
return \%plan_existing;
};
my $getplans_sub=sub {
my $plans=&Net::FullAuto::FA_Core::getplans();
if (-1<$#{$plans}) {
return $plans;
} else {
my $message=<<'END';
_ _ ___ _____ ___ _
| \| |/ _ \_ _| __| (_)
| .` | (_) || | | _| _
|_|\_|\___/ |_| |___| (_)
*NO* Plans have yet been 'made' with
this FullAuto installation.
To make a 'plan' use the --plan argument
in conjunction with the --code argument
invoked from the command line.
Example: fa --plan --code hello_world
Press ANY KEY to return to the Plan Menu
END
print $Net::FullAuto::FA_Core::blanklines,$message;
alarm 120;
Term::ReadKey::ReadMode('cbreak');
# Turn off controls keys
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';
$key = ReadKey(0);
};
alarm(0);
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');
return '{plan_menu}<';
}
};
my $generate_crontab=sub {
package generate_crontab;
no strict 'subs';
use BerkeleyDB;
use Digest::SHA qw(sha256_hex);
use Net::FullAuto::FA_Core;
use File::Path;
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);
my $progname=substr($0,(rindex $0,'/')+1,-3);
require "$loc/fa_global.pm";
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} ]][';
$data=~s/^[]](.*)[[]$/$1/s;
$data=~s/\]\|\[/],[/g;
$data=~s/\];/]/g;
print "DATA=$data\n";
my $output=eval $data;
print "ERROR=$@\n" if $@;
print "OUTPUT=$output\n";<STDIN>;
my ($monthstring,$weekdaysstring,$daystring,
$hourstring,$minstring,$weekstring,$track)=
('','','','','','',0);
if (ref $output->[1] eq 'ARRAY') {
if ($#{$output->[1]}==11
|| -1<index $output->[1]->[0],'Every') {
$monthstring='*';
} elsif ($#{$output->[1]}==0) {
$monthstring=$monthconv{$output->[1]->[0]};
} else {
my $cnt=$monthconv{$output->[1]->[0]};
my $save_start=$cnt;
foreach my $month (@{$output->[1]}) {
unless ($cnt++==$monthconv{$month}) {
$save_start=-1;
}
$monthstring.=$monthconv{$month}.',';
}
if (-1<$save_start) {
$monthstring=$save_start.'-'.
$monthconv{$output->[1]->[$#{$output->[1]}]};
} else {
chop $monthstring;
}
}
} elsif (-1<index $output->[1],'Every') {
$monthstring='*';
} else {
$monthstring=$monthconv{$output->[1]};
}
if (ref $output->[2] eq 'ARRAY') {
if ($#{$output->[2]}==6
|| -1<index $output->[2]->[0],'Any') {
$weekdaysstring='*';
} elsif ($#{$output->[2]}==0) {
my $day=$output->[2]->[0];
$day=~s/\s*$//;
print "DAY1=$day<==\n";
$weekdaysstring=$weekdaysconv{$day};
} else {
my $day=$output->[2]->[0];
$day=~s/\s*$//;
print "DAY2=$day\n";
my $cnt=$weekdaysconv{$day};
my $save_start=$cnt;
foreach my $weekday (@{$output->[2]}) {
$weekday=~s/\s*$//;
unless ($cnt++==$weekdaysconv{$weekday}) {
$save_start=-1;
}
$weekdaysstring.=$weekdaysconv{$weekday}.',';
}
if (-1<$save_start) {
print "FIVE={${$output->[2]}
[$#{$output->[2]}]\n";
my $day=$output->[2]->[$#{$output->[2]}];
$weekdaysstring=$save_start.'-'.
$weekdaysconv{$day};
} else {
chop $weekdaysstring;
}
}
} elsif (-1<index $output->[2],'Every') {
$weekdaysstring='*';
} else {
print "FOUR=$output->[2]\n";
my $day=$output->[2];
$day=~s/\s*$//;
$weekdaysstring=$weekdaysconv{$day};
}
if (ref $output->[3] eq 'ARRAY') {
if ($#{$output->[3]}==30
|| -1<index $output->[3]->[0],'Any') {
$daystring='*';
} elsif ($#{$output->[3]}==0) {
$daystring=unpack('x5 a*',$output->[3]->[0]);
} else {
my $cnt=unpack('x5 a*',$output->[3]->[0]);
my $save_start=$cnt;
foreach my $day (@{$output->[3]}) {
$day=unpack('x5 a*',$day);
unless ($cnt++==$day) {
$save_start=-1;
}
$daystring.=$day.',';
}
if (-1<$save_start) {
$daystring=$save_start.'-'.
$output->[3]->[$#{$output->[3]}];
} else {
chop $daystring;
}
}
} elsif (-1<index $output->[3],'Every') {
$daystring='*';
} else {
$daystring=unpack('x5 a*',{$output->[3]});
}
if (ref $output->[4] eq 'ARRAY') {
if ($#{$output->[4]}==23
|| -1<index $output->[4]->[0],'Every') {
$hourstring='*';
} elsif ($#{$output->[4]}==0) {
$hourstring=$hourconv{unpack('x6 a*',$output->[4]->[0])};
} else {
my $out=${$output->[4]}[0];
$out=~s/^.*Hour\s*(.*)$/$1/;
my $cnt=$hourconv{unpack('x6 a*',$out)};
my $save_start=$cnt;
foreach my $hour (@{$output->[4]}) {
$hour=~s/^.*Hour\s*(.*)$/$1/;
unless ($cnt++==$hourconv{unpack('x6 a*',$hour)}) {
$save_start=-1;
}
$hourstring.=$hourconv{unpack('x6 a*',$hour)}.',';
}
if (-1<$save_start) {
$hourstring=$save_start.'-'.
$hourconv{unpack('x6 a*',
$output->[4]->[$#{$output->[4]}])};
} else {
chop $hourstring;
}
}
} elsif (-1<index $output->[4],'Every') {
$hourstring='*';
} else {
$hourstring=$hourconv{unpack('x6 a*',$output->[4])};
}
if (ref $output->[5] eq 'ARRAY') {
if ($#{$output->[5]}==59
|| -1<index $output->[5]->[0],'Every') {
$minstring='*';
} elsif ($#{$output->[5]}==0) {
$minstring=unpack('x8 a*',$output->[5]->[0]);
} else {
my $cnt=unpack('x8 a*',$output->[5]->[0]);
my $save_start=$cnt;
foreach my $minute (@{$output->[5]}) {
$minute=unpack('x8 a*',$minute);
unless ($cnt++==$minute) {
$save_start=-1;
}
$minstring.=$minute.',';
}
if (-1<$save_start) {
$minstring=$save_start.'-'.
$output->[5]->[$#{$output->[5]}];
} else {
chop $minstring;
}
}
} elsif (-1<index $output->[5],'Every') {
$minstring='*';
} else {
$minstring=unpack('x8 a*',$output->[5]);
}
my $planstring=$output->[6]->[0];
$planstring=~s/^Plan:\s*(\d+)\s+.*$/$1/;
print "WEEKDATS=$weekdaysstring<==\n";
my $cronstring=$minstring.' '.$hourstring.' '.$daystring.' '.
$monthstring.' '.$weekdaysstring;
print "CRONSTRING=$cronstring and PLANSTRING=$planstring<==\n";<STDIN>;
my $crontabpath=$Net::FullAuto::FA_Core::gbp->('crontab');
my ($stdout,$stderr)=('','');
($stdout,$stderr)=Net::FullAuto::FA_Core::cmd("${crontabpath}crontab -l");
print "WAHT IS CRONTABSTDOUT=$stdout and STDERR=$stderr\n";<STDIN>;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Jobs');
my $username=&Net::FullAuto::FA_Core::username();
my $cronentry="$cronstring /usr/local/bin/fa --login ".
"$username ".
"--password --plan $planstring";
if ($stderr && -1<index $stderr,'no crontab') {
my $dig=sha256_hex($cronentry);
print "DIG=$dig and CRONENTRY=$cronentry\n";
($stdout,$stderr)=Net::FullAuto::FA_Core::cmd(
$Net::FullAuto::FA_Core::gbp->('printf').
"printf \"# FullAuto Job: $dig\012".
$cronentry."\012\"".' | crontab -');
} elsif ($stdout=~/^\s*[^#].*$/m) {
my $line='';
my %fullauto_jobs=();
my %all_cron_entries=();
my %line_lookup=();
foreach my $line (split "\n", $stdout) {
if ($line=~/^\s*[#] FullAuto Job: (\S+)$/) {
$fullauto_jobs{$1}='';
} else {
print "UNCOMMENTED LINE=$line<==\n";
my $dig=sha256_hex($line);
$all_cron_entries{$dig}=$line;
$line_lookup{$line}=$dig;
}
#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 "WE GOT CRON CONTENTS=$stdout<==\n";
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return '{plan_menu}<';
};
my %select_recurrent_minutes=(
Name => 'select_recurrent_minutes',
Item_1 => {
Text => 'Every Minute of the Hour (*)',
Result => $generate_crontab,
},
Item_2 => {
Text => "Minute ]C[",
#Select => 'Many',
Convey => [0..59],
Result => $generate_crontab,
},
Select => 'Many',
Banner => sub {
my $plan="]P[{existing_plans}";
$plan=~s/^["](.*)["]$/$1/s;
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 :"
},
);
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}";
$plan=~s/^["](.*)["]$/$1/s;
return " Select the --HOUR(S)-- of the Day Where\n\n ".
" $plan\n\n Will be Run :"
},
);
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}";
$plan=~s/^["](.*)["]$/$1/s;
return " Select the --DAY(S)-- of the Month Where\n\n ".
" $plan\n\n Will be Run :"
},
);
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}";
$plan=~s/^["](.*)["]$/$1/s;
return " Select the --WEEKDAY(S)-- Where\n\n ".
" $plan\n\n Will be Run :"
},
);
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}";
$plan=~s/^["](.*)["]$/$1/s;
return " Select the --MONTH(S)-- where\n\n ".
" $plan\n\n Will be Run :"
},
);
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 :",
);
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[ :",
);
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 :",
);
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 :",
);
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 :'
);
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 :\n\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 :\n\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}",
);
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[';
$choice=~s/^"(.*)"$/$1/s;
return " Select Type of Scheduled Job for\n\n Plan: $choice";
},
);
return \%select_type_of_scheduled_plan;
};
my $plan_options_work_with_sub=sub {
my $choice="]!T[{plan_menu}";
if ($choice eq '"Work with Existing Plans"') {
return $plan_existing_sub;
} elsif ($choice eq '"Set Up a New Scheduled Job"') {
return $select_type_of_scheduled_plan_sub;
} else {
return $plan_options_sub;
}
};
my $plan_menu_options_sub=sub {
my $plans=&Net::FullAuto::FA_Core::getplans();
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:'
);
return \%existing_plans;
} else {
my $message=<<'END';
_ _ ___ _____ ___ _
| \| |/ _ \_ _| __| (_)
| .` | (_) || | | _| _
|_|\_|\___/ |_| |___| (_)
*NO* Plans have yet been 'made' with
this FullAuto installation.
To make a 'plan' use the --plan argument
in conjunction with the --code argument
invoked from the command line.
Example: fa --plan --code hello_world
Press ANY KEY to return to the Plan Menu
END
print $Net::FullAuto::FA_Core::blanklines,$message;
alarm 120;
Term::ReadKey::ReadMode('cbreak');
# Turn off controls keys
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';
$key = ReadKey(0);
};
alarm(0);
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');
return '<';
}
};
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',
);
return \%setup_new_sched_job_menu;
};
my $plan_menu_banner=<<'END';
___ _ _ _ _ __ __
| _ \ |__ _ _ _ _| |_ _ | |___| |__ | \/ |___ _ _ _ _
| _/ / _` | ' \ |_ _| | || / _ \ '_ \ | |\/| / -_) ' \ || |
|_| |_\__,_|_||_| |_| \__/\___/_.__/ |_| |_\___|_||_\_,_|
Plan: Indicated by a Plan Number, A FullAuto 'Plan' is a
recording of user &Menu() choices and user input.
Job: A FullAuto Scheduled 'Job' is a fully unattended
invocation of a Custom Code Block via cron.
END
my %plan_menu=(
Name => 'plan_menu',
Item_1 => {
Text => 'Accept Defaults and Record New Plan',
Result => sub {
unless (grep { /--plan/i } @ARGV) {
my $message=<<'END';
___ _ _ _
|_ _|_ __ _ __ ___ _ _| |_ __ _ _ _| |_ | |
| || ' \| '_ \/ _ \ '_| _/ _` | ' \ _| |_|
|___|_|_|_| .__/\___/_| \__\__,_|_||_\__| (_)
|_|
This selection is not available when accessed
via the Admin Menu. This item is available only
when the --plan argument is used in conjunction
with the --code argument invoked from the command
line.
Example: fa --plan --code hello_world
Press ANY KEY to return to the Plan Menu
END
print $Net::FullAuto::FA_Core::blanklines,
$message;
alarm 120;
Term::ReadKey::ReadMode('cbreak');
# Turn off controls keys
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
# \n required
my $key='';
$key = ReadKey(0);
};
alarm(0);
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');
return '<';
}
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 => $plan_menu_banner,
);
my $plan_menu_sub = sub {
package plan_menu_sub;
use if (!defined $Net::FullAuto::FA_Core::localhost), 'Net::FullAuto';
our $fa_code='Net::FullAuto::FA_Core.pm';
unless (-1<index $Net::FullAuto::FA_Core::localhost,'=') {
$main::plan_menu_sub=1;
&Net::FullAuto::FA_Core::fa_login();
undef $main::plan_menu_sub;
}
return \%plan_menu;
};
sub plan {
#print "PLANCALLER=",caller,"\n";
my $output=&Menu(\%plan_menu);
&cleanup() if $output=~/\]quit\[/i;
#print "WHAT IS OUTPUTFRESH=$output\n";
my $outp=join ' ', @{$output} if ref $output eq 'ARRAY';
print "OUTPUT=$outp\n" if defined $outp && $outp;
my $username=&Net::FullAuto::FA_Core::username();
if ($output ne ']quit[') {
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Plans');
my $new_plan_number=0;
my ($k,$v) = ('','') ;
if (-1<index $output,'Accept Defaults and Record New Plan') {
my $cursor = $bdb->db_cursor() ;
my $status=$cursor->c_get($k, $v, DB_LAST);
$new_plan_number=++$k;
undef $cursor;
my $plann={ 'Number' =>$new_plan_number,
'Created'=>$Net::FullAuto::FA_Core::invoked[2],
'Creator'=>$username,
'Host' =>$Net::FullAuto::FA_Core::local_hostname,
'Expires'=>'never',
'Plan' =>[] };
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return $plann;
} elsif (-1<index $output,'Work with Existing Plans') {
my $plans=getplans($bdb);
if (-1<$#{$plans}) {
my %existing_plans=(
Name => 'existing_plans',
Item_1=> {
Text => "]C[",
Convey => $plans
},
Banner=> ' Select a Plan to work with:'
);
my $outp=Menu(\%existing_plans);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
undef $Net::FullAuto::FA_Core::makeplan;
&cleanup();
} else {
print "\n\n ########################### NOTE ".
"###########################\n\n".
" *NO* Plans have been \"made\" with ".
"this FullAuto installation.\n\n";
&cleanup();
}
} elsif (ref $output eq 'ARRAY' && $output->[0]
eq 'select_recurrent_minutes') {
my ($monthstring,$weekdaysstring,$daystring,
$hourstring,$minstring,$weekstring)=
('','','','','');
if (ref $output->[1] eq 'ARRAY') {
if ($#{$output->[1]}==11) {
$monthstring='*';
} elsif ($#{$output->[1]}==0) {
$monthstring=$monthconv{${$output->[1]}[0]};
} else {
my $cnt=$monthconv{${$output->[1]}[0]};
my $save_start=$cnt;
foreach my $month (@{$output->[1]}) {
unless ($cnt++==$monthconv{$month}) {
$save_start=-1;
}
$monthstring.=$monthconv{$month}.',';
}
if (-1<$save_start) {
$monthstring=$save_start.'-'.
$monthconv{${$output->[1]}
[$#{$output->[1]}]};
} else {
chop $monthstring;
}
}
} else {
$monthstring=$monthconv{$output->[1]};
}
if (ref $output->[2] eq 'ARRAY') {
if ($#{$output->[2]}==6) {
$weekdaysstring='*';
} elsif ($#{$output->[2]}==0) {
$weekdaysstring=$weekdaysconv{${$output->[2]}[0]};
} else {
my $cnt=$weekdaysconv{${$output->[2]}[0]};
my $save_start=$cnt;
foreach my $weekday (@{$output->[2]}) {
unless ($cnt++==$weekdaysconv{$weekday}) {
$save_start=-1;
}
$weekdaysstring.=$weekdaysconv{$weekday}.',';
}
if (-1<$save_start) {
$weekdaysstring=$save_start.'-'.
$weekdaysconv{${$output->[2]}
[$#{$output->[2]}]};
} else {
chop $weekdaysstring;
}
}
} else {
$weekdaysstring=$weekdaysconv{$output->[2]};
}
if (ref $output->[3] eq 'ARRAY') {
if ($#{$output->[3]}==30) {
$daystring='*';
} elsif ($#{$output->[3]}==0) {
$daystring=unpack('x5 a*',${$output->[3]}[0]);
} else {
my $cnt=unpack('x5 a*',${$output->[3]}[0]);
my $save_start=$cnt;
foreach my $day (@{$output->[3]}) {
$day=unpack('x5 a*',$day);
unless ($cnt++==$day) {
$save_start=-1;
}
$daystring.=$day.',';
}
if (-1<$save_start) {
$daystring=$save_start.'-'.
${$output->[3]}[$#{$output->[3]}];
} else {
chop $daystring;
}
}
} else {
$daystring=unpack('x5 a*',{$output->[3]});
}
if (ref $output->[4] eq 'ARRAY') {
if ($#{$output->[4]}==23) {
$hourstring='*';
} elsif ($#{$output->[4]}==0) {
$hourstring=$hourconv{${$output->[4]}[0]};
} else {
my $cnt=$hourconv{unpack('x6 a*',${$output->[4]}[0])};
my $save_start=$cnt;
foreach my $hour (@{$output->[4]}) {
unless ($cnt++==$hourconv{unpack('x6 a*',$hour)}) {
$save_start=-1;
}
$hourstring.=$hourconv{unpack('x6 a*',$hour)}.',';
}
if (-1<$save_start) {
$hourstring=$save_start.'-'.
$hourconv{unpack('x6 a*',${$output->[4]}
[$#{$output->[4]}])};
} else {
chop $hourstring;
}
}
} else {
$hourstring=$hourconv{unpack('x6 a*',$output->[4])};
}
if (ref $output->[5] eq 'ARRAY') {
if ($#{$output->[5]}==59) {
$minstring='*';
} elsif ($#{$output->[5]}==0) {
$minstring=unpack('x8 a*',${$output->[5]}[0]);
} else {
my $cnt=unpack('x8 a*',${$output->[5]}[0]);
my $save_start=$cnt;
foreach my $minute (@{$output->[5]}) {
$minute=unpack('x8 a*',$minute);
unless ($cnt++==$minute) {
$save_start=-1;
}
$minstring.=$minute.',';
}
if (-1<$save_start) {
$minstring=$save_start.'-'.
${$output->[5]}[$#{$output->[5]}];
} else {
chop $minstring;
}
}
} else {
$minstring=unpack('x8 a*',$output->[5]);
}
my $planstring=$output->[6];
my $cronstring=$minstring.' '.$hourstring.' '.$daystring.' '.
$monthstring.' '.$weekdaysstring;
print "CRONSTRING=$cronstring\n";
our $crontabpath='';
if (-e '/usr/bin/crontab') {
$crontabpath='/usr/bin/';
} elsif (-e '/bin/crontab') {
$crontabpath='/bin/';
} elsif (-e '/usr/local/bin/crontab') {
$crontabpath='/usr/local/bin/';
}
my ($stdout,$stderr)=('','');
($stdout,$stderr)=cmd("${crontabpath}crontab -l");
#print "WAHT IS CRONTABSTDOUT=$stdout\n";
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Jobs');
if ($stderr && -1<index $stderr,'no crontab') {
$planstring=~tr/ //s;
my $plnn=$planstring;
$plnn=~s/^(\d+).*$/$1/;
my $dig=sha256_hex("$cronstring /usr/local/bin/fa --login ".
"$username --password --plan $plnn");
($stdout,$stderr)=cmd($Net::FullAuto::FA_Core::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='';
foreach my $line (split "\n", $stdout) {
if ($line=~/^\s*[#]/) {
next if (-1<index $line,'# DO NOT EDIT T');
next if $line=~/^# \(.* installed on /;
next if (-1<index $line,'# (Cron version');
print "COMMENTED LINE=$line\n";
my @plancom=split ' ',$line;
my $plnum='';my $chksum='';
#print "WHAT IS THIS=$plancom[$#plancom-2]\n";
if ($plancom[$#plancom-1] eq ']|[') {
$chksum=$plancom[$#plancom];
$plnum=$plancom[3];
}
#print "PLAN=$plnum and CHKSUM=$chksum\n";
} else {
print "UNCOMMENTED LINE=$line<==\n";
my $tesline=sha256_hex($line);
print "TESTLINE=$tesline<==\n";
}
#print "LINE=$line\n";
}
print "WE GOT CRON CONTENTS=$stdout<==\n";
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "STDOUTCRONT=$stdout<==\n";
print "STDERRCRONT=$stderr<==\n";
}
undef $Net::FullAuto::FA_Core::makeplan;
&cleanup();
} else {
undef $Net::FullAuto::FA_Core::makeplan;
&cleanup();
}
}
sub persist_get {
my $key=$_[0]||'';
my $value='';
&handle_error("Missing Arguements: ".
"&persist_get\(\[key\]\)")
unless $key;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Persist');
$key.='&';
$key.=join '&', caller;
$key.='&'.$Net::FullAuto::FA_Core::local_hostname.$username;
my $status=$bdb->db_get($key,$value);
$value||='';
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return ($value,$key,$status);
}
sub persist_put {
my $key=$_[0]||'';
my $value=$_[1]||'';
&handle_error("Missing Arguements: ".
"&persist_put\(".
"\[key_returned_from_persist_get\],".
"\[string_to_persist\]\)")
unless $key && $value;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Persist');
my $status=$bdb->db_put($key,$value);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return $status;
}
sub getplan {
my $plan=$_[0];
$plan=~s/^.*\s*Plan:\s+(\d+)\s+.*$/$1/;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Plans');
my $cursor=$bdb->db_cursor();
my ($k,$v)=('','');
my $planhash='';
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
#print "WHAT IS K=$k<== and PLAN=$plan\n";
if ($k eq $plan) {
$v=~s/\$HASH\d*\s*=\s*//s;
$planhash=eval $v;
$planhash->{'Title'}||='';
last;
}
}
undef $cursor;
return $plan,$planhash,$bdb,$dbenv if wantarray;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return $planhash;
}
sub getplans {
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Plans');
my $cursor=$bdb->db_cursor();
my @plans=();
my ($k,$v)=('','');
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
$v=~s/\$HASH\d*\s*=\s*//s;
my $planhash=eval $v;
$planhash->{'Title'}||='';
push @plans, pack('A10',$k).$planhash->{'Title'};
}
$cursor->c_close();
undef $cursor;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return \@plans;
}
sub sysreadline(*;$) {
my($handle, $timeout) = @_;
$handle = qualify_to_ref($handle, caller());
my $infinitely_patient = (@_ == 1 || $timeout < 0);
my $start_time = time();
my $selector = IO::Select->new();
$selector->add($handle);
my $line = '';
SLEEP:
until (at_eol($line)) {
unless ($infinitely_patient) {
return $line if time() > ($start_time + $timeout);
}
#sleep only 1 second before checking again
next SLEEP unless $selector->can_read(1.0);
INPUT_READY:
while ($selector->can_read(0.0)) {
my $was_blocking = $handle->blocking(0);
CHAR: while (sysread($handle, my $nextbyte, 1)) {
$line .= $nextbyte;
last CHAR if $nextbyte eq "\n";
}
$handle->blocking($was_blocking);
# if incomplete line, keep trying
next SLEEP unless at_eol($line);
last INPUT_READY;
}
}
return $line;
} sub at_eol($) { $_[0] =~ /\n\z/ }
sub acquire_fa_lock
{
my @topcaller=caller;
my $trace = Devel::StackTrace->new();
print "\nINFO: acquire_fa_lock() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nacquire_fa_lock() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $fullauto_lock_id=(defined $_[0] && $_[0])?$_[0]:'1234';
my $lock_description=(defined $_[1] && $_[1])?$_[1]:'';
my $cache=(defined $_[2] && $_[2])?$_[2]:'';
my $maxnumberallowed=(defined $_[3] && $_[3])?$_[3]:1;
my $killafterseconds=(defined $_[4] && $_[4])?$_[4]:0;
my $enable_this_lock=(defined $_[5] && $_[5])?$_[5]:1;
my $wait_for_newlock=(defined $_[6] && $_[6])?$_[6]:60;
my $pollingmillisecs=(defined $_[7] && $_[7])?$_[7]:500;
my $return_if_locked=(defined $_[8] && $_[8])?$_[8]:0;
if (ref $_[0] eq 'HASH') {
$fullauto_lock_id=$_[0]->{'FullAuto_Lock_ID'}
if exists $_[0]->{'FullAuto_Lock_ID'};
if (exists $Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}) {
$maxnumberallowed=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'MaxNumberAllowed'}||1;
$killafterseconds=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'KillAfterSeconds'}||0;
if (exists $Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Enable_This_Lock'} && $Net::FullAuto::FA_Core::locks->
{$fullauto_lock_id}->{'Enable_This_Lock'}==0) {
$enable_this_lock=0;
} else {
$enable_this_lock=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Enable_This_Lock'}||1;
}
$lock_description=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Lock_Description'}
||'';
if (exists $Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Wait_For_NewLock'} && $Net::FullAuto::FA_Core::locks->
{$fullauto_lock_id}->{'Wait_For_NewLock'}==0) {
$wait_for_newlock=0
} else {
$wait_for_newlock=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Wait_For_NewLock'}||60;
}
$pollingmillisecs=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'PollingMilliSecs'}||500;
$return_if_locked=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Return_If_Locked'}||0;
}
$lock_description=$_[0]->{'Lock_Description'}
if exists $_[0]->{'Lock_Description'};
$cache=$_[0]->{'Cache'} if exists $_[0]->{'Cache'};
$maxnumberallowed=$_[0]->{'MaxNumberAllowed'}
if exists $_[0]->{'MaxNumberAllowed'};
$killafterseconds=$_[0]->{'KillAfterSeconds'}
if exists $_[0]->{'KillAfterSeconds'};
$enable_this_lock=$_[0]->{'Enable_This_Lock'}
if exists $_[0]->{'Enable_This_Lock'};
$wait_for_newlock=$_[0]->{'Wait_For_NewLock'}
if exists $_[0]->{'Wait_For_NewLock'};
$pollingmillisecs=$_[0]->{'PollingMilliSecs'}
if exists $_[0]->{'PollingMilliSecs'};
$return_if_locked=$_[0]->{'Return_If_Locked'}
if exists $_[0]->{'Return_If_Locked'};
} elsif (exists $Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}) {
$maxnumberallowed=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'MaxNumberAllowed'}||1;
$killafterseconds=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'KillAfterSeconds'}||0;
if (exists $Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Enable_This_Lock'} && $Net::FullAuto::FA_Core::locks->
{$fullauto_lock_id}->{'Enable_This_Lock'}==0) {
$enable_this_lock=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Enable_This_Lock'}||1;
}
$lock_description=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Lock_Description'}||'';
if (exists $Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Wait_For_NewLock'} && $Net::FullAuto::FA_Core::locks->
{$fullauto_lock_id}->{'Wait_For_NewLock'}==0) {
$wait_for_newlock=0;
} else {
$wait_for_newlock=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Wait_For_NewLock'}||60;
}
$pollingmillisecs=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'PollingMilliSecs'}||500;
$return_if_locked=
$Net::FullAuto::FA_Core::locks->{$fullauto_lock_id}->
{'Return_If_Locked'}||0;
}
my $locks='';my $getnewlock=0;my $newlock={};my $queue='';
my @letoct=split '', $fullauto_lock_id;
my $letoct='';
foreach my $c (@letoct) {
if ($c=~/\d/) {
$letoct.=$c;
} else {
$enable_this_lock=1 unless $enable_this_lock;
$letoct.=ord($c);
}
}
my $username=&Net::FullAuto::FA_Core::username();
my $mr="__Master_".$$."__";
unless (exists $Hosts{$mr}) {
$mr="__Master_".getppid."__";
}
unless ($Net::FullAuto::FA_Core::bdb_locks) {
my $mkdflag=0;
unless (exists $Net::FullAuto::FA_Core::Hosts{$mr}
{'berkeley_db_path'}) {
if (-w "/var/db/Berkeley/FullAuto") {
$Hosts{"__Master_${$}__"}{'berkeley_db_path'}=
"/var/db/Berkeley/FullAuto/";
} else {
my $home_dir=File::HomeDir->my_home.'/';
mkdir "$home_dir/.fullauto" unless
-d "$home_dir/.fullauto";
chmod 0770, "$home_dir/.fullauto";
mkdir "$home_dir/.fullauto/db" unless
-d "$home_dir/.fullauto/db";
chmod 0770, "$home_dir/.fullauto/db";
$Hosts{"__Master_${$}__"}{'berkeley_db_path'}
="$home_dir/.fullauto/db/";
}
}
unless (-d $Net::FullAuto::FA_Core::Hosts{$mr}
{'berkeley_db_path'}.'Locks') {
$mkdflag=1;
my $stdout='';my $stderr='';
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
$m.$Hosts{$mr}{'berkeley_db_path'}.'Locks';
($stdout,$stderr)=&setuid_cmd($cmd,5);
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';
if ($m) {
my $cd=cwd();
chdir $m.$Hosts{$mr}{'berkeley_db_path'}.'Locks';
my $cmd=$Net::FullAuto::FA_Core::gbp->('bash').
'bash -c umask u=rwx,g=rwx,o=rwx';
($stdout,$stderr)=&setuid_cmd($cmd,5);
chdir $cd;
}
}
my $ff=$Net::FullAuto::FA_Core::Hosts{$mr}{'berkeley_db_path'}.
"Locks/lock_$letoct.flag";
if (-e $ff) {
open (FF,"<$ff") || &handle_error("FATAL ERROR: Cannot open $ff");
my $lock_info=<FF>;
close FF;
$lock_info||=0;
$lock_info=~s/\s*$//s;
my @lock_info=();
@lock_info=split '|',$lock_info if -1<index $lock_info,'|';
$lock_info[1]||=0;
if ($lock_info[1] && (time>$lock_info[1]+5)) {
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');
my $cmd="$d -h ".$Hosts{$mr}{'berkeley_db_path'}.'Locks';
my $out=`$cmd`;
&handle_error($out) if $out;
unlink $ff;
my $kill_arg=($^O eq 'cygwin')?'f':9;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=&kill($lock_info[0],$kill_arg)
if &testpid($lock_info[0]);
}
}
$ENV{FA_ACQUIRING_BERKELEY_DB_LOCK}=$ff;
my $kas=$killafterseconds||
$Net::FullAuto::FA_Core::locks->{$letoct}->{'KillAfterSeconds'}
||0;
if ($kas) {
open (FF,">$ff") || &handle_error("FATAL ERROR: Cannot open $ff");
my $ltime=time + $kas;
$ltime=0 if $kas==0;
print FF "$$|$ltime";
close FF;
}
unless ($Net::FullAuto::FA_Core::dbenv_locks) {
$Net::FullAuto::FA_Core::dbenv_locks = BerkeleyDB::Env->new(
-Home => $Net::FullAuto::FA_Core::Hosts{$mr}{'berkeley_db_path'}.
'Locks',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL,
-LockDetect => DB_LOCK_DEFAULT
);
if (-1==index $BerkeleyDB::Error,'Successful return') {
&handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n");
}
}
$Net::FullAuto::FA_Core::bdb_locks = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_locks.db",
-Flags => DB_CREATE,
-Compare => sub { my $z=$_[0]||0;my $o=$_[1]||0;$z <=> $o },
-Env => $Net::FullAuto::FA_Core::dbenv_locks
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n");
unlink $ff if $kas;
delete $ENV{FA_ACQUIRING_BERKELEY_DB_LOCK};
if ($mkdflag) {
my $stdout='';my $stderr='';
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{$mr}{'berkeley_db_path'}.'Locks/*';
($stdout,$stderr)=&setuid_cmd($cmd,5);
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';
}
}
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_get($letoct,$locks);
print $Net::FullAuto::FA_Core::LOG "acquire_fa_lock() ",
"ALL LOCKS=$locks and LOCK_ID_OCT=$letoct and STATUS=$status\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my @processes=();
unless ($status) {
$locks=~s/\$HASH\d*\s*=\s*//s;
$locks=eval $locks;
@processes=keys %{$locks};
}
if (-1<$#processes) {
my @proc=();my $pn=0;
foreach my $proc (keys %{$locks}) {
if (exists $locks->{$proc}->{'FullAuto_Lock_ID'} &&
$locks->{$proc}->{'FullAuto_Lock_ID'} eq $fullauto_lock_id) {
$pn++;
}
}
$maxnumberallowed=$locks->{$processes[0]}->{'MaxNumberAllowed'}||1;
$killafterseconds=$locks->{$processes[0]}->{'KillAfterSeconds'}||0;
if (exists $locks->{$processes[0]}->{'Enable_This_Lock'} &&
$locks->{$processes[0]}->{'Enable_This_Lock'}==0) {
$enable_this_lock=0;
} else {
$enable_this_lock=$locks->{$processes[0]}->{'Enable_This_Lock'}||1;
}
$lock_description=$locks->{$processes[0]}->{'Lock_Description'}||'';
if (exists $locks->{$processes[0]}->{'Wait_For_NewLock'} &&
$locks->{$processes[0]}->{'Wait_For_NewLock'}==0) {
$wait_for_newlock=0;
} elsif (!defined $wait_for_newlock || $wait_for_newlock<0) {
$wait_for_newlock=$locks->{$processes[0]}->{'Wait_For_NewLock'}||60;
}
$pollingmillisecs=$locks->{$processes[0]}->{'PollingMilliSecs'}||500;
$return_if_locked=$locks->{$processes[0]}->{'Return_If_Locked'}||0;
$newlock={
FullAuto_Lock_ID => $fullauto_lock_id,
MaxNumberAllowed => $maxnumberallowed,
KillAfterSeconds => $killafterseconds,
Enable_This_Lock => $enable_this_lock,
Lock_Description => $lock_description,
Wait_For_NewLock => $wait_for_newlock,
PollingMilliSecs => $pollingmillisecs,
Return_If_Locked => $return_if_locked,
};
if ($maxnumberallowed>$pn) {
print $Net::FullAuto::FA_Core::LOG "acquire_fa_lock() ",
"GETTING NEW LOCK for $$ because MAX ALLOWED: ",
"$maxnumberallowed > NUM OF LOCKS: $pn\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$getnewlock=1;
} else {
print $Net::FullAuto::FA_Core::LOG "acquire_fa_lock() ",
"*NOT* GETTING NEW LOCK for $$ because MAX ALLOWED: ",
"$maxnumberallowed < NUM OF LOCKS: $pn\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $ps=$Net::FullAuto::FA_Core::gbp->('ps').'ps -ef';
my ($psout,$pserr)=Net::FullAuto::FA_Core::cmd($ps);
if ($pserr=~/password[: ]+$/si) {
$psout=`$ps 2>&1`;
}
my %pid=();my %ppid=();
foreach my $line (split "\n", $psout) {
$line=~/^I*\s*[^ ]+\s+(\d+)\s+(\d+).*$/;
my $pid=$1||0;my $ppid=$2||0;
$pid{$pid}=$ppid;
push @{$ppid{$ppid}},$pid;
}
my @del_locks=();
foreach my $proc (@processes) {
my $process=$proc;
unless (exists $pid{$process}) {
push @del_locks, $process;
next;
} elsif ($killafterseconds) {
my ($stdout,$stderr)=('','');
my $t=time;
my $ta=$locks->{$process}->{'TimeLockAcquired'};
$ta+=$killafterseconds;
if ($t>$ta) {
my $family=find_kids($process,[],\%ppid);
foreach my $member (@{$family}) {
print $Net::FullAuto::FA_Core::LOG
"acquire_fa_lock() ",
"KILLING THIS PROCESS: $process ",
"after $killafterseconds seconds\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
eval {
kill INT => -$member;
};
print $Net::FullAuto::FA_Core::LOG
"acquire_fa_lock() ",
"KILL ERROR IS ==>$@<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*'
&& $@;
}
push @del_locks, $process;
next;
}
}
}
if (-1<$#del_locks) {
foreach my $process (@del_locks) {
print $Net::FullAuto::FA_Core::LOG
"acquire_fa_lock() ",
"DELETING LOCK FOR THIS PROCESS: $process\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
delete $locks->{$process};
}
if (-1==$#{[keys %{$locks}]}) {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_del(
$letoct);
} else {
$locks=Data::Dump::Streamer::Dump($locks)->Out();
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_put(
$letoct,$locks);
}
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_get(
$letoct,$locks);
if ($status) {
$getnewlock=1;
} else {
$locks=~s/\$HASH\d*\s*=\s*//s;
$locks=eval $locks;
$locks||={};
my @processes=keys %{$locks};
my $pn=$#processes+1;
unless ($maxnumberallowed>=$pn) {
$getnewlock=1;
}
}
}
my $expired_flag=0;
if (!$getnewlock) {
return 0 if $return_if_locked &&
exists $locks->{$processes[0]}->{'Wait_For_NewLock'} &&
$locks->{$processes[0]}->{'Wait_For_NewLock'}<1;
$locks->{$processes[0]}->{'Wait_For_NewLock'}||=60;
my $expires=time+$locks->{$processes[0]}->{'Wait_For_NewLock'};
my $p_length=length $pollingmillisecs;
my $polling=$pollingmillisecs;
if ($p_length==3) {
$polling="0.$polling";
} elsif ($p_length==2) {
$polling="0.0$polling";
} elsif ($p_length==1) {
$polling="0.00$polling";
} else {
$polling=~s/^(\d+)(\d\d\d)/$1.$2/;
}
my $pollcount=0;my $dotcount=0;
my @dots=('. ','. . ','. . . ');
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";
}
while (time<$expires) {
$dotcount=0 if 2<$dotcount;
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
STDOUT->autoflush(1);
printf("\r% 0s",
"Waitingggg for another process with lock ID ".
"[$fullauto_lock_id] to finish (".$pollcount++.") ".
$dots[$dotcount]);
STDOUT->autoflush(0);
}
select(undef,undef,undef,$polling);
$cache->set($cache->{'key'}, [0,
"Waiting for another processxx with lock ID ".
"[$fullauto_lock_id] "."to finish (".$pollcount++.
") $dots[$dotcount++]"]) if $cache;
$expired_flag=1;
$status=$Net::FullAuto::FA_Core::bdb_locks->db_get(
$letoct,$locks);
$locks=~s/\$HASH\d*\s*=\s*//s;
$locks=eval $locks;
my @proc=();my $pn=0;
foreach my $proc (keys %{$locks}) {
if (exists $locks->{$proc}->{'FullAuto_Lock_ID'} &&
$locks->{$proc}->{'FullAuto_Lock_ID'}
eq $fullauto_lock_id) {
$pn++;
}
}
if ($status || $maxnumberallowed>$pn) {
$expired_flag=0;
last;
}
}
}
if ($status || $expired_flag==0) {
$getnewlock=1;
} elsif ($return_if_locked) {
return 0;
} else {
my $max=" Maximum Number Allowed => "
."$maxnumberallowed\n\n";
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;
$cache->set($cache->{'key'}, [1,$die])
if $cache;
&handle_error($die);
}
}
} else {
$maxnumberallowed=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'MaxNumberAllowed'}||1
unless $maxnumberallowed;
$killafterseconds=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'KillAfterSeconds'}||0
unless $killafterseconds;
$enable_this_lock=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'Enable_This_Lock'}||1
unless (defined $enable_this_lock && $enable_this_lock==0);
$lock_description=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'Lock_Description'}||''
unless $lock_description;
if (!defined $wait_for_newlock || $wait_for_newlock<0) {
$wait_for_newlock=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'Wait_For_NewLock'}||60
}
$pollingmillisecs=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'PollingMilliSecs'}||500
unless $pollingmillisecs;
$return_if_locked=
$Net::FullAuto::FA_Core::locks->{$letoct}->{'Return_If_Locked'}||0
unless $return_if_locked;
$newlock={
FullAuto_Lock_ID => $fullauto_lock_id,
MaxNumberAllowed => $maxnumberallowed,
KillAfterSeconds => $killafterseconds,
Enable_This_Lock => $enable_this_lock,
Lock_Description => $lock_description,
Wait_For_NewLock => $wait_for_newlock,
PollingMilliSecs => $pollingmillisecs,
Return_If_Locked => $return_if_locked,
UserName => $username,
Logfile => $Hosts{$mr}{'LogFile'}
};
$getnewlock=1;
}
if ($getnewlock) {
return 0 if (!(exists $newlock->{'Enable_This_Lock'} &&
$newlock->{'Enable_This_Lock'}));
$newlock->{'FullAuto_Proc_ID'}=$$;
$newlock->{'FA_Proc_Launched'}=\@invoked;
$newlock->{'TimeLockAcquired'}=time;
$locks||={};
$locks->{$$}=$newlock;
$locks=Data::Dump::Streamer::Dump($locks)->Out();
print $Net::FullAuto::FA_Core::LOG "acquire_fa_lock() ",
"NEW LOCK => $locks\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_put($letoct,$locks);
return 1 unless $status;
return 0;
}
}
sub release_fa_lock
{
my $trace = Devel::StackTrace->new();
print "\nINFO: release_fa_lock() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nrelease_fa_lock() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $lockid=(defined $_[0] && $_[0])?$_[0]:'1234';
my @letoct=split '', $lockid;
my $letoct='';
foreach my $c (@letoct) {
if ($c=~/\d/) {
$letoct.=$c;
} else {
$letoct.=ord($c);
}
}
my $locks='';
if ($Net::FullAuto::FA_Core::bdb_locks) {
my $status=$Net::FullAuto::FA_Core::bdb_locks->db_get($letoct,$locks);
if ($status) {
$Net::FullAuto::FA_Core::bdb_locks->db_del($letoct);
return 0;
}
$locks=~s/\$HASH\d*\s*=\s*//s;
$locks=eval $locks;
if (exists $locks->{$$}) {
delete $locks->{$$};
}
if (keys %{$locks}) {
$locks=Data::Dump::Streamer::Dump($locks)->Out();
$status=$Net::FullAuto::FA_Core::bdb_locks->db_put(
$letoct,$locks);
} else {
$status=$Net::FullAuto::FA_Core::bdb_locks->db_del(
$letoct);
}
}
return 0;
}
sub acquire_semaphore
{
my @topcaller=caller;
my $sem='';
my $IPC_KEY=(defined $_[0] && $_[0])?$_[0]:'1234';
my $process_description=$_[1]||'';
my $pd="$process_description " if $process_description;
$pd||='';
print "acquire_semaphore() ${pd}CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "acquire_semaphore() ${pd}CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $semaphorecount=$_[2];
my $semaphore_count;
$semaphore_count=(defined $semaphorecount && 0<$semaphorecount) ?
$semaphorecount : 1;
&handle_error(("IPC Semaphore FATAL ERROR:\n\n"
." semaphore count argument must greater than zero\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__')
if $semaphore_count<1;
my $semaphore_timeout=$_[3]||180;
if (0) {
#if ($^O eq 'cygwin') {
# try to open a semaphore
my $sem=Win32::Semaphore->open($IPC_KEY);
if (defined $sem && $sem) {
# wait for semaphore to be zero
my $previous='';
if ($semaphore_count<2) {
if ($process_description
&& ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet)) {
print
"\n\n Status: Waiting for lock release. Another FullAuto",
"\n process has a lock on ",$process_description,
"\n . . .\n\n";
}
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($timeout-1);
my $stim=$semaphore_timeout * 1000;
$sem->wait($stim);
sleep 2;
};alarm(0);
if ($@) {
&handle_error(("Win32 Semaphore Timed Out:\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
}
} elsif (!$sem->release(1,$previous)) {
&handle_error(("FATAL ERROR: Maximum Number of FullAuto Processes"
." Exists:\n\n"
." Maximum Number => $semaphore_count\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
}
}
# create a semaphore
--$semaphore_count if 1<$semaphore_count;
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=
Win32::Semaphore->new(0,$semaphore_count,$IPC_KEY)
|| &handle_error(("Could not create Win32 Semaphore: $!\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
} else {
# create a semaphore
unless ($IPC_KEY=~/^\d+$/) {
$IPC_KEY=sha256_hex($IPC_KEY);
$IPC_KEY=~s/[A-Z|a-z]//g;
$IPC_KEY=substr($IPC_KEY,0,4);
}
$sem = IPC::Semaphore->new($IPC_KEY,$semaphore_count,&S_IRWXU);
if (defined $sem && $sem) {
if ($semaphore_count<2) {
if ($process_description
&& ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet)) {
print
"\n\n Status: Waiting for lock release. Another FullAuto",
"\n process has a lock on ",$process_description,
"\n . . .\n",
"\n (Hint: If lock fails to release in a reasonable",
"\n time period, use command line tools 'ipcs'",
"\n and 'ipcrm' to investigate and resolve, or",
"\n simply restart the host computer)\n";
}
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($timeout-1);
# Decrement the semaphore count by 1
my $success=
$sem->op(0,-1,&SEM_UNDO);
# blocks if semaphore is zero
my $result = int $!; # capture the value of errno
$success||=0;$result||=0;
if (!$success && $result == &EINTR) {
die $result;
}
sleep 2;
};alarm(0);
if ($@) {
&handle_error(("IPC Semaphore Timed Out:\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
}
} else {
my $value=$sem->getval(0);
if ($semaphore_count<=$value) {
# semaphore was zero, no slots available
&handle_error(
("FATAL ERROR: Maximum Number of FullAuto Processes"
." Exists:\n\n"
." Maximum Number => $semaphore_count: $!\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
} else {
$sem->op(0,1,&SEM_UNDO);
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=$sem;
}
}
} else {
# create a semaphore
$sem=IPC::Semaphore->new(
$IPC_KEY,$semaphore_count,&S_IRWXU|&IPC_CREAT)
|| &handle_error(("Could not create IPC Semaphore\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
$sem->op(0,1,&SEM_UNDO) if 1<$semaphore_count;
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=$sem;
}
}
return $sem
}
sub test_semaphore
{
my @topcaller=caller;
print "test_semaphore() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "test_semaphore() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $IPC_KEY=$_[0];
$IPC_KEY||=1234;
my $opstring='';
my $opstring1='';
my $opstring2='';
my $semnum=0;
my $semop=0;
my $semflag=0;
if ($^O eq 'cygwin') {
# try to open a semaphore
if (Win32::Semaphore->open($IPC_KEY)) {
return 1;
} else {
return 0;
}
} elsif (0) {
}
}
sub release_semaphore
{
my @topcaller=caller;
print "release_semaphore() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "release_semaphore() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $IPC_KEY=$_[0]||0;
my $semaphore_timeout=$_[1]||180;
if (exists $Net::FullAuto::FA_Core::semaphores{$IPC_KEY}) {
if (0) {
#if ($^O eq 'cygwin') {
# Increment the semaphore count by 1
# Destroy the semaphore
my $previous='';
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->release(1,$previous);
delete $Net::FullAuto::FA_Core::semaphores{$IPC_KEY};
# once past this point, any process waiting can proceed
} else {
# Increment the semaphore count by 1
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->op(0,1,&SEM_UNDO);
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->remove;
delete $Net::FullAuto::FA_Core::semaphores{$IPC_KEY};
# once past this point, any process waiting can proceed
}
}
}
sub kill
{
my @topcaller=caller;
print "\nINFO: main::kill() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::kill() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $pid=$_[0];my $arg=$_[1]||'';my $cmd=[];
my $stdout='';my $ignore='';
my $killpath=$Net::FullAuto::FA_Core::gbp->('kill');
my $bashpath=$Net::FullAuto::FA_Core::gbp->('bash');
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');
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::LOG "BEFOREKILL -> ",join ' ',@{$cmd},"\n"
if -1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($stdout_capture,$stderr_capture)=('','');
($stdout_capture,$stderr_capture)=
Capture::Tiny::capture {
($ignore,$stdout)=&setuid_cmd($cmd,5);
};
$stdout||='';
if (wantarray) {
return $stdout,'';
} else { return $stdout }
}
sub testpid
{
my @topcaller=caller;
print "\nINFO: main::testpid() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::testpid() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $pid=$_[0];
if (!$pid) {
if (wantarray) {
return 0,'';
} else { return 0 }
}
my $killpath=$Net::FullAuto::FA_Core::gbp->('kill');
my $bashpath=$Net::FullAuto::FA_Core::gbp->('bash');
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');
my $stdout='';my $stderr='';
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" ];
my ($stdout_capture,$stderr_capture)=('','');
($stdout_capture,$stderr_capture)=
Capture::Tiny::capture {
($stdout,$stderr)=&setuid_cmd($cmd,5); # Save Pound Sign
};
if ($stdout_capture=~s/^stdout: ?//) {
$stdout=$stdout_capture;
} elsif ($stdout_capture) {
if (ref $stdout_capture eq 'SCALAR') {
$stderr=$$stdout_capture;
}
}
} 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' ];
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
}
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nppppppp &main::testpid() ppppppp STDOUT ",
"==>$stdout<== and STDERR ==>$stderr<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if (wantarray) {
return $stdout, $stderr;
} elsif ($stdout) {
return $stdout;
} elsif ($stderr!~/^\s*$/) {
$stderr=~tr/\0-\11\13-\37\177-\377//d;
chomp($stderr);
print "XXERROR=$stderr<== and CALLER=",caller,"<==\n";<STDIN>;
&Net::FullAuto::FA_Core::handle_error($stderr);
} else { return $stdout }
}
sub get_master_info
{
my $Local_HostName='';my $Local_FullHostName='';
my $Local_IP_Address={};
$Local_HostName=(uname)[1];
$Local_HostName=&Sys::Hostname::hostname if !$Local_HostName;
my $addr='';
if ($^O ne 'cygwin') {
if ($Local_HostName!~/^localhost\.local/) {
$addr=gethostbyname($Local_HostName) ||
&handle_error(
"Couldn't Resolve Local Hostname $Local_HostName : ");
my $gip=sprintf "%vd", $addr;
# --CONTINUE-- print "WHAT IS GIP=$gip<==\n";
$same_host_as_Master{$gip}='-';
$Local_IP_Address->{$gip}='-';
$Local_FullHostName=gethostbyaddr($addr,AF_INET) ||
handle_error(
"Couldn't Re-Resolve Local Hostname $Local_HostName : ");
} else {
my $gip='127.0.0.1';
$same_host_as_Master{$gip}='-';
$Local_IP_Address->{$gip}='-';
$Local_FullHostName=$Local_HostName;
}
} else {
#my $route=cmd('cmd /c route print',3);
my $route=cmd('route print',3);
my $getip=0;
foreach my $line (split /^/, $route) {
if (!$getip) {
if (-1<index $line, 'Metric') {
$getip=1;
} else { next }
} else {
my $gip=(split ' ', $line)[3];
next if !$gip;
next if -1==index $gip,'.';
$Local_IP_Address->{$gip}='-';
$same_host_as_Master{$gip}='-';
next if $gip=~/\d+\.0\.0\.1/;
}
}
}
$Local_FullHostName=$Local_HostName if !$Local_FullHostName;
$same_host_as_Master{$Local_HostName}='hostname';
$same_host_as_Master{$Local_FullHostName}='fullhostname';
return $Local_HostName,$Local_FullHostName,$Local_IP_Address;
}
sub check_Hosts
{
our ($Local_HostName,$Local_FullHostName,$Local_IP_Address)=
&get_master_info;
my $chk_hostname='';my $chk_ip='';my $trandir_flag='';
my $name=substr($_[0],0,-3);
$name=~s/^.*[\\|\/](.*)$/$1/;
my @Hosts=();
{
no warnings;
@Hosts=eval "\@${name}::Hosts";
}
my @Cycle=@Hosts;
my $username=&Net::FullAuto::FA_Core::username();
HOST: foreach my $h (@Cycle) {
my $host=$h;
my $hostn='';my $ipn='';my $lh_key=0;
foreach my $keee (keys %{$host}) {
my $ke=$keee;
if (lc($ke) eq 'label' && lc($host->{$ke}) eq 'localhost') {
$lh_key=1;
} elsif (lc($ke) eq 'hostname') {
$hostn=$host->{$ke};
} elsif (lc($ke) eq 'ip') {
$ipn=$host->{$ke};
}
}
if ($hostn eq lc($Local_FullHostName)) {
$chk_hostname=$Local_FullHostName;
} elsif ($hostn eq lc($Local_HostName)) {
$chk_hostname=$Local_HostName;
} elsif (exists $Local_IP_Address->{$ipn}) {
$chk_ip=$ipn;
} elsif ($lh_key) {
} else { next }
}
if (!$chk_hostname && !$chk_ip) {
my $hostn='';my $ip='';
if ($Local_FullHostName) {
$hostn="\'HostName'=>\'$Local_FullHostName\'\,";
} elsif ($Local_HostName) {
$hostn="\'HostName'=>\'$Local_HostName\'\,";
}
if (keys %{$Local_IP_Address}) {
$ip="'IP'=>\'".(keys %{$Local_IP_Address})[0]."\',";
}
my $label="\'Label\'=>\'__Master_${$}__\',";
my $uname="'Uname'=>'".(uname)[0]."',";
my $local="'Local'=>'connect_ssh_telnet',";
my $remote="'Remote'=>'connect_host',";
unshift @Hosts,
eval "\{ $ip$hostn$label$uname$local$remote \}";
} return \@Hosts;
}
$Hosts{"__Master_${$}__"}{'HostName'}=&Sys::Hostname::hostname if
!exists $Hosts{"__Master_${$}__"}{'HostName'};
$Hosts{"__Master_${$}__"}{'IP'}='' if
!exists $Hosts{"__Master_${$}__"}{'IP'};
if (!exists $Hosts{"__Master_${$}__"}{'Cipher'}) {
$Hosts{"__Master_${$}__"}{'Cipher'}='DES';
} else {
eval "require " . $Hosts{"__Master_${$}__"}{'Cipher'};
&handle_error($@) if $@;
}
my %msproxies=();my %uxproxies=();my %labels=();
my $msflag='';my $uxflag='';
sub host_hash
{
foreach my $host (@{$_[0]}) {
$host->{'Label'}||='';
$host->{'label'}||='';
$host->{'label'}=$host->{'Label'} if exists $host->{'Label'};
if (exists $labels{$host->{'label'}} &&
($host->{'label'} ne "__Master_${$}__")) {
&handle_error("DUPLICATE LABEL DETECTED - $host->{'label'}");
} $labels{$host->{'label'}}='' if $host->{'label'};
foreach my $key (keys %{$host}) {
$Hosts{$host->{'label'}}->{$key}=$host->{$key};
$Hosts{$host->{'label'}}->{lc($key)}=$host->{$key};
}
if (exists $Hosts{$host->{'label'}}->{'loginid'}) {
$Hosts{$host->{'label'}}->{'login'}=
$Hosts{$host->{'label'}}->{'loginid'};
$Hosts{$host->{'label'}}->{'username'}=
$Hosts{$host->{'label'}}->{'loginid'};
} elsif (exists $Hosts{$host->{'label'}}->{'login'}) {
$Hosts{$host->{'label'}}->{'loginid'}=
$Hosts{$host->{'label'}}->{'login'};
$Hosts{$host->{'label'}}->{'username'}=
$Hosts{$host->{'label'}}->{'login'};
} elsif ($Hosts{$host->{'label'}}->{'username'}) {
$Hosts{$host->{'label'}}->{'loginid'}=
$Hosts{$host->{'label'}}->{'username'};
$Hosts{$host->{'label'}}->{'login'}=
$Hosts{$host->{'label'}}->{'username'};
}
}
foreach my $key (keys %same_host_as_Master) {
if (exists $Hosts{$key}{'berkeley_db_path'}) {
$Hosts{$key}{'berkeley_db_path'}.='/' if
substr($Hosts{$key}{'berkeley_db_path'},-1) ne '/';
$Hosts{"__Master_${$}__"}{'berkeley_db_path'}=
$Hosts{$key}{'berkeley_db_path'};
last
}
}
if (!exists $Hosts{"__Master_${$}__"}{'berkeley_db_path'}) {
unless (-d '/var/db/Berkeley/FullAuto') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
unless (-d '/var/db') {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
$m.'/var/db';
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
&handle_error($stderr) if $stderr;
}
unless (-d '/var/db/Berkeley') {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
$m.'/var/db/Berkeley';
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
&handle_error($stderr) if $stderr;
}
unless (-d '/var/db/Berkeley/FullAuto') {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
$m.'/var/db/Berkeley/FullAuto';
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
&handle_error($stderr) if $stderr;
}
}
if (!(-d '/var/db/Berkeley/FullAuto' && -w _)) {
&handle_error("Cannot Write to Berkeley FullAuto Directory :".
"\n\n ".
'/var/db/Berkeley/FullAuto');
}
$Hosts{"__Master_${$}__"}{'berkeley_db_path'}=
'/var/db/Berkeley/FullAuto/';
} elsif (!(-d $Hosts{"__Master_${$}__"}{'berkeley_db_path'} && -w _)) {
handle_error("Cannot Write to Berkeley FullAuto Directory :".
"\n\n ".
$Hosts{"__Master_${$}__"}{'berkeley_db_path'});
} else {
$Hosts{"__Master_${$}__"}{'berkeley_db_path'}.='/' if
substr($Hosts{"__Master_${$}__"}{'berkeley_db_path'},-1) ne '/';
}
my $FA_Core_path='';
foreach my $key (keys %INC) {
if (-1<index $key,'FA_Core.pm') {
$FA_Core_path=substr($INC{$key},0,(rindex $INC{$key},'/')+1);
last;
}
} $Hosts{"__Master_${$}__"}{'FA_Core'}=$FA_Core_path;
}
&host_hash(\@Hosts);
my ($ps_stdout,$ps_stderr,$ps_retcod);
($ps_stdout,$ps_stderr,$ps_retcod)=
&cmd($Net::FullAuto::FA_Core::gbp->('ps').'ps');
sub get_all_hosts
{
return keys %Hosts;
}
sub connect_sftp
{
push @_, '__sftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_ftp
{
push @_, '__ftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_ftp_sftp
{
push @_, '__ftp_sftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_sftp_ftp
{
push @_, '__sftp_ftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_shell
{
my @topcaller=caller;
print "connect_shell() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "connect_shell() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
push @_, '__shell__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE1\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::LOG "GOTSSHCONNECTERRORDYING\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE2\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $handle;
}
}
sub connect_ssh
{
my @topcaller=caller;
print "connect_ssh() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "connect_ssh() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
push @_, '__ssh__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE1\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::LOG "GOTSSHCONNECTERRORDYING\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE2\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $handle;
}
}
sub connect_ssh_telnet
{
my @topcaller=caller;
print "connect_ssh-telnet() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "connect_ssh-telnet() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
push @_, '__ssh_telnet__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE1\n";
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::LOG "GOTSSHCONNECTERRORDYING\n";
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE2\n";
return $handle;
}
}
sub connect_telnet_ssh
{
my @topcaller=caller;
print "connect_ssh-telnet() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "connect_ssh-telnet() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
push @_, '__telnet_ssh__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE1\n";
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::LOG "GOTSSHCONNECTERRORDYING\n";
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE2\n";
return $handle;
}
}
sub connect_secure
{
my @topcaller=caller;
print "connect_secure() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "connect_secure() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
push @_, '__secure__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE1\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::LOG "GOTSSHCONNECTERRORDYING\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE2\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
return $handle;
}
}
sub connect_insecure
{
my @topcaller=caller;
print "connect_insecure() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "connect_insecure() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
push @_, '__insecure__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE1\n";
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::LOG "GOTSSHCONNECTERRORDYING\n";
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::LOG "RETURNINGSSH_HANDLE2\n";
return $handle;
}
}
sub connect_telnet
{
push @_, '__telnet__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_reverse
{
push @_, '__reverse__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_mozrepl
{
unless (defined $_[0] && $_[0]) {
}
push @_, '__telnet__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
my $shell=$handle->{_shell};
if (defined $Net::FullAuto::FA_Core::ff_flag) {
foreach my $n (1..30) {
my $loc=$handle->repl("$shell.whereAmI()");
last if -1<index $loc,'FullAuto Software';
if ($n==5 || $n==10 || $n==15) {
my $go_to='content.document.location.href='.
'"http://www.FullAuto.com"';
my ($out,$error)=$handle->repl($go_to);
}
sleep 1;
}
}
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_cmd
{
my @topcaller=caller;
print "\nINFO: main::connect_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::connect_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_host
{
my @topcaller=caller;
print "\nINFO: main::connect_host() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::connect_host() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $c=($^O ne 'MSWin32' && $^O ne 'MSWin64' && !exists
$ENV{PAR_TEMP})?'©':'(C)';
#my $envv=`env`;
#print "ENVV FOR WINDOWS INSTALLER=$envv<== ENVV FOR WINDOWS INSTALLER\n";sleep 2;
print "STARTING FullAuto$c on ". localtime() . "\n"
if !($Net::FullAuto::FA_Core::quiet) &&
(ref $localhost ne 'GLOB') && !(defined $main::aws)
&& !(ref $_[0] eq 'HASH' && exists $_[0]->{quiet}
&& $_[0]->{quiet}==1) &&
(-1==index $topcaller[1],'Net/FullAuto');
my $caller=(caller(1))[3];
substr($caller,0,(index $caller,'::')+2)='';
my $sub='';my $_connect='connect_host';my $cache='';
my $hostlabel=$_[0];
my $quiet=0;
$quiet=1 if grep { /__quiet__/ } @_;
if ((-1<index $caller,'connect_ftp')
|| (-1<index $caller,'connect_ssh')
|| (-1<index $caller,'connect_sftp')
|| (-1<index $caller,'connect_secure')
|| (-1<index $caller,'connect_shell')
|| (-1<index $caller,'connect_telnet')
|| (-1<index $caller,'connect_insecure')
|| (-1<index $caller,'connect_reverse')
|| (-1<index $caller,'connect_mozrepl')) {
my $connect_caller=$caller;
$_connect=(split '::', $caller)[2];
($caller,$sub)=split '::', (caller(2))[3];
$caller.='.pm';
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';
$Hosts{$hostlabel}{'HostName'}='localhost';
$Hosts{$hostlabel}{'hostname'}='localhost';
$Hosts{$hostlabel}{'Label'}=$hostlabel;
$Hosts{$hostlabel}{'label'}=$hostlabel;
$Hosts{$hostlabel}{'telnetport'}=4242;
$_connect='connect_telnet';
} elsif (ref $_[0] eq 'HASH') {
$authorize_connect=1;
foreach my $key (keys %{$_[0]}) {
$_[0]->{lc($key)}=$_[0]->{$key};
}
if (exists $_[0]->{'loginid'}) {
$_[0]->{'login'}=$_[0]->{'loginid'};
$_[0]->{'username'}=$_[0]->{'loginid'};
} elsif (exists $_[0]->{'login'}) {
$_[0]->{'loginid'}=$_[0]->{'login'};
$_[0]->{'username'}=$_[0]->{'login'};
} elsif (exists $_[0]->{'username'}) {
$_[0]->{'loginid'}=$_[0]->{'username'};
$_[0]->{'login'}=$_[0]->{'username'};
}
$Hosts{$_[0]->{'label'}}=$_[0];
$hostlabel=$_[0]->{'label'};
} elsif ($_[0] eq '__shell__') {
$hostlabel="Localhost Shell";
$Hosts{$hostlabel}{'HostName'}='localhost';
$Hosts{$hostlabel}{'hostname'}='localhost';
$Hosts{$hostlabel}{'Label'}=$hostlabel;
$Hosts{$hostlabel}{'label'}=$hostlabel;
$_connect='connect_shell';
}
} else {
my @called=caller(2);
if ((-1<index $caller,'mirror') || (-1<index $caller,'login_retry')) {
$sub=$called[3]
} else {
$caller=$called[3];
$caller=(caller(0))[0] if $caller=~/[(]eval[)]/;
$called[6]||='';
$sub=($called[6])?$called[6]:$called[3];
$sub=~s/^.*:://;
} $sub=~s/\s*\;\n*//
}
$Net::FullAuto::FA_Core::cltimeout||='X';
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$timeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (defined $_[1] && $_[1]=~/^[1-9]+/) {
$timeout=$_[1];
} elsif (defined $_[1] && (-1<index $_[1],'Cache::FileCache')) {
$cache=$_[1];
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");
}
}
} elsif (defined $_[1] &&
(-1<index $_[1],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[1]->chi_root_class)) {
$cache=$_[1];
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");
}
}
} elsif ((-1==index $caller,'mirror') &&
(-1==index $caller,'login_retry')) {
my $time_out='$' . (caller)[0] . '::timeout';
$time_out= eval $time_out;
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;
} else { $timeout=$time_out }
} else { print "FOUR\n";$timeout=30 }
if (defined $_[2] && lc($_[2]) ne '__telnet__' && lc($_[2]) ne '__ftp__') {
$Net::FullAuto::FA_Core::test=$_[2];
} elsif (defined $_[2] && (-1<index $_[2],'Cache::FileCache')) {
$cache=$_[2];
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");
}
}
} elsif (defined $_[2] &&
(-1<index $_[2],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[2]->chi_root_class)) {
$cache=$_[2];
unless (exists $cache->{'key'} && $cache->{'key'}) {
if ($cache_key) {
$cache->{'key'}=$cache_key;
} else {
handle_error("A cache object exists, ".
"but a cache key is not defined");
}
}
} else {
my $tst='$' . (caller)[0] . '::test';
$tst= eval $tst;
$tst||=0;
if ($@ || $tst!~/^[1-9]+/) {
$Net::FullAuto::FA_Core::test=0;
} else { $Net::FullAuto::FA_Core::test=$tst }
}
if (!$cache && $main::cache) {
$cache=$main::cache;
}
unless (exists $Hosts{$hostlabel}) {
my $die="\n FATAL ERROR - The First Argument to "
."&connect_host()\n -> \"$hostlabel"
."\"\n Called from the User Defined "
."Subroutine\n -> \&$sub\n "
." in the \"Custom Code\" module file"
."\n -> $caller is NOT a\n"
." Valid Host Label\n\n"
." Be sure there is Valid Host "
."Block\n Entry in the Hosts file\n"
." -> $Net::FullAuto::FA_Core::fa_host .\n\n";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
&handle_error($die,'__cleanup__');
}
my $new_handle='';my $stderr='';
if ($_connect eq 'connect_ssh'
|| $_connect eq 'connect_shell'
|| $_connect eq 'connect_telnet') {
($new_handle,$stderr)=new Rem_Command($hostlabel,
'__new_master__',$_connect,$cache);
print $Net::FullAuto::FA_Core::LOG
"connect_host()1 STDERRFOR1011=$stderr<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
} else {
($new_handle,$stderr)=new File_Transfer($hostlabel,
'__new_master__',$_connect,$cache,
$quiet);
print $Net::FullAuto::FA_Core::LOG
"connect_host()2 STDERRFOR1011=$stderr<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
if (wantarray) {
print $Net::FullAuto::FA_Core::LOG "RETURNING1\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $new_handle,$stderr;
} elsif (!$stderr) {
print $Net::FullAuto::FA_Core::LOG "RETURNING2\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $new_handle;
} else {
print $Net::FullAuto::FA_Core::LOG "DIEINGNOWHERE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__');
}
}
sub cache
{
my @topcaller=caller;
print "\nINFO: main::cache() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::cache() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $caller=(caller(1))[3];
substr($caller,0,(index $caller,'::')+2)='';
my $hostlabel=$_[0];
my $path_to_cache_root=$_[1]||$master_transfer_dir;
my $namespace=$_[2]||&Net::FullAuto::FA_Core::username();
my @called=caller(2);
$caller=$called[3];
$caller=(caller(0))[0] if $caller=~/[(]eval[)]/;
$called[6]||='';
my $sub=($called[6])?$called[6]:$called[3];
$sub=~s/^.*:://;
$sub=~s/\s*\;\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 $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
&handle_error($die,'__cleanup__');
}
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 $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
&handle_error($die,'__cleanup__');
}
unless (ref $Hosts{$hostlabel}->{Cache} eq 'CODE') {
my @called=caller(2);
$caller=$called[3];
$caller=(caller(0))[0] if $caller=~/[(]eval[)]/;
$called[6]||='';
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 $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $die if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
&handle_error($die,'__cleanup__');
}
}
if (exists $Hosts{$hostlabel} and exists $Hosts{$hostlabel}->{Cache}) {
return $Hosts{$hostlabel}->{Cache}->($path_to_cache_root,$namespace);
} elsif ($main::cache) {
return $main::cache;
}
}
sub memnow
{
my $stdout='';my $stderr='';my $all=0;
$all=1 if $_[0] && grep { /__all__/i } @_;
if ($_[0] && ref $_[0] eq 'HASH') {
if ($^O eq 'cygwin') {
($stdout,$stderr)=&Net::FullAuto::FA_Core::cmd(
$_[0],"cat /proc/meminfo");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'__cleanup__') if $stderr
&& !wantarray
}
} else {
if ($^O eq 'cygwin') {
($stdout,$stderr)=&Net::FullAuto::FA_Core::cmd("cat /proc/meminfo");
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__')
if $stderr && !wantarray
}
}
if (!$all && $^O eq 'cygwin') {
my $cnt=0;
foreach my $line (split /^/, $stdout) {
next if !$cnt++;
$stdout=substr($line,(rindex $line,' ')+1,-1);
last;
}
}
if (wantarray) {
return $stdout, $stderr;
} else {
return $stdout;
}
}
sub handle_error
{
#print "handleerror caller=",caller,"\n";
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "FA_Core::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "FA_Core::handle_error() CALLER=",
(join ' ',@topcaller),"\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
my $return=0;
my $line_adjust=0;my $warn=0;
my $error=$_[0]||'';my $track='';
my $cleanup=0;
my $mail='';my $new_invoked='';
if (defined $_[1] && $_[1]) {
if (ref $_[1] eq 'HASH') {
$mail=$_[1];
} elsif (ref $_[1] eq 'ARRAY') {
$track=$_[1];
} else {
if ($_[1] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[1] eq '__return__') {
$return=$_[1];
} elsif ($_[1] eq '__warn__') {
$warn=1;
} elsif ($_[1]=~/^\s*-(\d+)\s*$/) {
$line_adjust=-$1;
} else {
print "ARG1 is NOT recognized\n==>$_[1]<==\n";
}
}
}
if (defined $_[2] && $_[2]) {
if (ref $_[2] eq 'HASH') {
$mail=$_[2];
} elsif (ref $_[2] eq 'ARRAY') {
$track=$_[2];
} else {
if ($_[2] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[2] eq '__return__') {
$return=$_[2];
} elsif ($_[2] eq '__warn__') {
$warn=1;
} elsif ($_[2]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG2 is NOT recognized\n==>$_[2]<==\n";
}
}
}
if (defined $_[3] && $_[3]) {
if (ref $_[3] eq 'HASH') {
$mail=$_[3];
} elsif (ref $_[3] eq 'ARRAY') {
$track=$_[3];
} else {
if ($_[3] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[3] eq '__return__') {
$return=$_[3];
} elsif ($_[3] eq '__warn__') {
$warn=1;
} elsif ($_[3]=~/^-(\d+)/) {
$line_adjust=-$1;
} else {
print "ARG3 is NOT recognized\n==>$_[3]<==\n";
}
}
}
if (defined $_[4] && $_[4]) {
if (ref $_[4] eq 'HASH') {
$mail=$_[4];
} elsif (ref $_[4] eq 'ARRAY') {
$track=$_[4];
} else {
if ($_[4] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[4] eq '__return__') {
$return=$_[4];
} elsif ($_[4] eq '__warn__') {
$warn=1;
} elsif ($_[4]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG4 is NOT recognized\n==>$_[4]<==\n";
}
}
}
if (defined $_[5] && $_[5]) {
if (ref $_[5] eq 'HASH') {
$mail=$_[5];
} elsif (ref $_[5] eq 'ARRAY') {
$track=$_[5];
} else {
if ($_[5] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[5] eq '__return__') {
$return=$_[5];
} elsif ($_[5] eq '__warn__') {
$warn=1;
} elsif ($_[5]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG5 is NOT recognized\n==>$_[5]<==\n";
}
}
}
if (defined $_[6] && $_[6]) {
if (ref $_[6] eq 'HASH') {
$mail=$_[6];
} elsif (ref $_[6] eq 'ARRAY') {
$track=$_[6];
} else {
if ($_[6] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[6] eq '__return__') {
$return=$_[6];
} elsif ($_[6] eq '__warn__') {
$warn=1;
} elsif ($_[6]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG6 is NOT recognized\n==>$_[6]<==\n";
}
}
} my $line='';
if ($line_adjust) {
if (unpack('a1',$line_adjust) eq '-') {
$line_adjust=unpack('x1 a*',$line_adjust);
$line=$topcaller[2]-$line_adjust;
} else {
$line=$topcaller[2]+$line_adjust;
}
} else { $line=$topcaller[2] }
my $tie_err='';my $trackdb='';my $hostlabel='';
my $command='';my $suberr='';
if ($track) {
($trackdb=${$track}[0])=~s/\.db$//;
$hostlabel=${$track}[1];
$command=${$track}[2];
$suberr=${$track}[3] if defined ${$track}[3] && ${$track}[3];
$suberr||='';
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Track');
my $tref='';
my $status=$bdb->db_get($invoked[2],$tref);
$tref=eval $tref;
if (!$status && exists ${$tref}{"${hostlabel}_$command"}
&& ${$tref}{"${hostlabel}_$command"}
eq $error) {
# loop the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);
}
}
$cursor->c_close();
undef $cursor;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 1,'';
} elsif ($suberr && exists ${$tref}{"${hostlabel}_$suberr"}
&& ${$tref}{"${hostlabel}_$suberr"}
eq $suberr) {
# loop the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);
}
}
$cursor->c_close();
undef $cursor;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 1,'';
} else {
$tref->{"${hostlabel}_$command"}=$error;
my $put_tref=Data::Dump::Streamer::Dump($tref)->Out();
$status=$bdb->db_put($invoked[2],$put_tref);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
$return='__return__';
}
# loop the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);
}
}
$cursor->c_close();
undef $cursor;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
} my $errtxt='';
if (10<length $error && unpack('a11',$error) ne 'FATAL ERROR') {
$error=~s/\s*$//s;$error=~s/^\s*//s;
$errtxt="$error\n\n at $topcaller[0] "
."$topcaller[1] line $line.\n";
} else {
$errtxt=$error
}
#print $Net::FullAuto::FA_Core::LOG "HANDLE_ERROR ERRTXT=$errtxt<==\n";
if ($errtxt=~/^You have mail/) {
print $Net::FullAuto::FA_Core::LOG "\nAttn: --> $errtxt\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\nAttn: --> $errtxt\n\n";
return
} elsif ($track || $return || $cleanup) {
print $Net::FullAuto::FA_Core::LOG "\n $errtxt"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\n $errtxt"
}
if ($mail) {
if ($warn) {
send_email($mail,$Net::FullAuto::FA_Core::debug,'__warn__');
} else { send_email($mail,$Net::FullAuto::FA_Core::debug) }
} elsif (!$mail && exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error'
&& ($track && ($cleanup || $return))) {
my %mail=(Body=>" $errtxt");
if ($warn) {
send_email(\%mail,$Net::FullAuto::FA_Core::debug,'__warn__');
} else { send_email(\%mail,$Net::FullAuto::FA_Core::debug) }
}
if ($track) {
if (wantarray) {
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 0,$errtxt;
} else {
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 0,'';
}
} elsif ($cleanup) {
&cleanup($return,'ERROR');
} else {
print "WE ARE GOING TO DIE IN HANDLE_ERROR and CALLER=",
(join ' ',@topcaller),"\n" if
!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
if ($return && $warn) {
print "\n $errtxt\n";
} else { handle_error($errtxt,'__cleanup__') }
}
}
sub lookup_hostinfo_from_label
{
my @topcaller=caller;
print "lookup_hostinfo_from_label() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "lookup_hostinfo_from_label() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $ip='';my $hostname='';my $use='';my $ms_share='';
my $ms_domain='';my $cmd_cnct=[''];my $ftr_cnct=[''];
my $login_id='';my $su_id='';my $chmod='';my $ping='';
my $owner='';my $group='';my $transfer_dir='';
my $uname='';my $proxy='';my $identityfile='';
my $ip_flag='';my $hn_flag='';my $password='';
my $spawn='bash';my $local_pw='';my $log='';
my $hostlabel=$_[0];my $_connect=$_[1]||'';my $debug='';
$hostlabel="__Master_${$}__" if lc($hostlabel) eq 'localhost';
my $timeout=0;
$use=$Hosts{$hostlabel}{'Use'} if exists
$Hosts{$hostlabel}{'Use'} &&
$Hosts{$hostlabel}{'Use'};
my $defined_use=0;
$defined_use=$use if $use;
$ping=$Hosts{$hostlabel}{'Ping'} if exists
$Hosts{$hostlabel}{'Ping'} &&
$Hosts{$hostlabel}{'Ping'};
foreach my $key (keys %{$Hosts{$hostlabel}}) {
print $Net::FullAuto::FA_Core::LOG
"KEY FROM HOST HASH=$key and USE=$use\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$use || (!$defined_use && $ip && !$hostname)) {
if ($key eq 'IP') {
if (ref $Hosts{$hostlabel}{$key} eq 'CODE') {
$ip=$Hosts{$hostlabel}{$key}->();
} else {
$ip=$Hosts{$hostlabel}{$key};
}
if (exists $same_host_as_Master{$ip} || $ping) {
if (exists $same_host_as_Master{$ip}
|| !(&ping($ip,'__return__'))[1]) {
$use='ip';
} else { $ip_flag=1 }
}
} elsif (lc($key) eq 'hostname') {
$hostname=$Hosts{$hostlabel}{$key};
if ($hostname && $ping) {
if (&ping($hostname,'__return__')) {
$use='hostname';
} else {
my $pinghost=$hostname;
$pinghost=substr($hostname,0,
(index $hostname,'.'))
if -1<index $hostname,'.';
if (&ping($pinghost,'__return__')) {
$Hosts{$hostlabel}{'HostName'}=$pinghost;
$hostname=$pinghost;
$use='hostname';
} else { $hn_flag=1 }
}
}
}
} elsif (lc($key) eq 'ip') {
$ip=$Hosts{$hostlabel}{$key};
if (!exists $same_host_as_Master{$ip} && $ping) {
unless (&ping($ip,'__return__')) {
if ($defined_use eq 'ip') {
$ip_flag=1;$defined_use=0;$use=0;
}
}
}
} elsif (lc($key) eq 'hostname') {
$hostname=$Hosts{$hostlabel}{$key};
if ($ping) {
my $pinghost=$hostname;
$pinghost=substr($hostname,0,
(index $hostname,'.'))
if -1<index $hostname,'.';
unless (&ping($pinghost,'__return__')) {
if ($defined_use eq 'hostname') {
$hn_flag=1;$defined_use=0;$use=0;
}
}
}
}
if (lc($key) eq 'ms_share') {
$ms_share=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'MS_Domain') {
$ms_domain=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'Remote') {
my $rem_cnct=$Hosts{$hostlabel}{$key};
if (!exists $same_host_as_Master{$hostlabel}) {
if ($_connect && $rem_cnct ne $_connect) {
if (($rem_cnct eq 'connect_ssh'
|| $rem_cnct eq 'connect_telnet'
|| $rem_cnct eq 'connect_sftp'
|| $rem_cnct eq 'connect_ftp')
|| (($_connect eq 'connect_secure'
|| $_connect eq 'connect_insecure')
&& ($rem_cnct ne 'connect_host'
&& $rem_cnct ne 'connect_reverse'))) {
my $die.="\n \"Remote\" Value: \'$rem_cnct\'"
."\n for Host Block --> $hostlabel"
."\n in file "
.$Net::FullAuto::FA_Core::fa_host
."\n conflicts with calling connect"
."\n method: $_connect";
&handle_error($die);
} elsif ($_connect eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];
$cmd_cnct=[ 'ssh' ];
} elsif ($_connect eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];
$cmd_cnct=[ 'telnet' ];
} elsif ($_connect eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];
$cmd_cnct=[ 'ssh','telnet' ];
} elsif ($_connect eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];
$cmd_cnct=[ 'telnet','ssh' ];
}
}
} else {
if ($rem_cnct eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];
$cmd_cnct=[ 'ssh' ];
} elsif ($rem_cnct eq 'connect_ssh') {
$cmd_cnct=[ 'ssh' ];
} elsif ($rem_cnct eq 'connect_sftp') {
$ftr_cnct=[ 'sftp' ];
} elsif ($rem_cnct eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];
$cmd_cnct=[ 'ssh','telnet' ];
} elsif ($rem_cnct eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];
$cmd_cnct=[ 'telnet' ];
} elsif ($rem_cnct eq 'connect_telnet') {
$cmd_cnct=[ 'telnet' ];
} elsif ($rem_cnct eq 'connect_ftp') {
$ftr_cnct=[ 'ftp' ];
} elsif ($ftr_cnct eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];
$cmd_cnct=[ 'telnet','ssh' ];
}
}
} elsif ((lc(unpack('a1',$key)) eq 'l') && (lc($key) eq 'loginid'
|| $key eq 'login')) {
$login_id=$Hosts{$hostlabel}{$key};
$Hosts{$hostlabel}{'LoginID'}=$login_id;
} elsif ((lc(unpack('a1',$key)) eq 's') && (lc($key) eq 'su' ||
lc($key) eq 'su_id' || lc($key) eq 'suloginid'
|| lc($key) eq 'suid' || lc($key) eq 'sulogin')) {
$su_id=$Hosts{$hostlabel}{$key};
$Hosts{$hostlabel}{'SU_ID'}=$su_id;
} elsif (lc($key) eq 'chmod') {
$chmod=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'owner') {
$owner=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'group') {
$group=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'timeout') {
$timeout=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'transferdir') {
$transfer_dir=$Hosts{$hostlabel}{$key};
$transfer_dir=~s/[\/\\]*$//;
} elsif (lc($key) eq 'uname') {
$uname=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'password') {
$password=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'debug') {
$Net::FullAuto::FA_Core::debug=1;
} elsif (lc($key) eq 'quiet') {
$Net::FullAuto::FA_Core::quiet=1;
} elsif (lc($key) eq 'proxy') {
$proxy=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'identityfile') {
$identityfile=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'spawn') {
$spawn=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'localpw') {
$local_pw=$Hosts{$hostlabel}{$key};
} elsif (lc($key) eq 'log') {
$log=$Hosts{$hostlabel}{$key};
Net::FullAuto::FA_Core::log($log)
unless $LOG;
}
print $Net::FullAuto::FA_Core::LOG
"GOING BACK TO TOP OF FOR LOOP\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
if (!$#{$ftr_cnct}) {
if ($_connect eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];
$cmd_cnct=[ 'ssh' ];
} elsif ($_connect eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];
$cmd_cnct=[ 'ssh','telnet' ];
} elsif ($_connect eq 'connect_ssh') {
$cmd_cnct=[ 'ssh' ];
} elsif ($_connect eq 'connect_sftp') {
$ftr_cnct=[ 'sftp' ];
} elsif ($_connect eq 'connect_shell') {
$cmd_cnct=[ 'shell' ];
} elsif ($_connect eq 'connect_telnet') {
$cmd_cnct=[ 'telnet' ];
} elsif ($_connect eq 'connect_ftp') {
$ftr_cnct=[ 'ftp' ];
} elsif ($_connect eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];
$cmd_cnct=[ 'telnet' ];
} elsif ($_connect eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];
$cmd_cnct=[ 'telnet','ssh' ];
}
}
print $Net::FullAuto::FA_Core::LOG "WHAT IS USE?=$use\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$use || (!$ip && !$hostname)) {
my $die="Cannot Contact Server \'$hostlabel\' -";
my $fah=$Net::FullAuto::FA_Core::fa_host;
if ($ip_flag) {
$die.="\n ping (1) failed for ip address $ip";
if ($hn_flag) {
$die.="\n and hostname: $hostname\n" if $hostname;
} &handle_error($die);
} elsif ($hn_flag) {
$die.="\n ping (2) failed for hostname: $hostname &"
."\n No ip address if defined for Server"
."\n --> $hostlabel in $fah file.";
&handle_error($die);
} elsif ($hostname || ($use eq 'ip' && !$ip)) {
$use='hostname';
} elsif ($ip) {
$use='ip';
} else {
$die.="\n No ip address or hostname defined for Server"
."\n --> $hostlabel in $fah file.";
&handle_error($die);
}
} elsif ($use eq 'hostname' && !$hostname && $ip) {
$use='ip';
} elsif ($use eq 'ip' && !$ip && $hostname) {
$use='hostname';
}
return ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$timeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw);
}
sub pty_do_cmd
{
my @topcaller=caller;
print "\nINFO: FA_Core::pty_do_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nFA_Core::pty_do_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cmd='';my @args=();
($cmd,@args)=@_;
my $pty='';my $pty_err='';my $try=0;
my $capture = IO::Capture::Stderr->new();
$capture->start();
while (1) {
my $m="Hint: Try Rebooting the Local Host";
eval {
$pty = IO::Pty->new;
};
if ($@) {
if ($@=~/Cannot open/is && $try++!=4) {
sleep $try;next;
} else {
my @all_lines = $capture->read || ();
$capture->stop();
$all_lines[$#all_lines]||='';
&Net::FullAuto::FA_Core::handle_error(
$@."\n $all_lines[$#all_lines]\n $m");
}
} else { last }
}
$capture->stop();
$try=0;my $child='';
my $cmd_err=join ' ',@{$cmd};
my $one=shift @{$cmd};
my $doslave=${$cmd}[$#{$cmd}] eq '_slave_' ? pop @{$cmd} : '';
my $two='';my $three='';
my $four='';my $five='';
if (-1<$#{$cmd}) {
$two=shift @{$cmd};
if (-1<$#{$cmd}) {
$three=shift @{$cmd};
if (-1<$#{$cmd}) {
$four=shift @{$cmd};
}
}
}
while (1) {
my $m="Hint: Try Rebooting the Local Host";
eval {
$child = fork;
};
if ($@) {
if ($@=~/temporarily unavailable/ && $try++!=4) {
sleep 5;next;
} else {
&Net::FullAuto::FA_Core::handle_error($@."\n $m");
}
} else { last }
}
return $pty,$child if $child; # Save Pound Sign
POSIX::setsid or &handle_error("setsid failed: ".($!)); # Save Pound Sign
my $tty = $pty->slave; # Save Pound Sign
$pty->make_slave_controlling_terminal
if ($^O eq 'cygwin') || ($doslave eq '_slave_'); # Save Pound Sign
CORE::close $pty; # Save Pound Sign
STDIN->fdopen($tty,"<") or &handle_error("STDIN: ".($!)); # Save Pound Sign
STDOUT->fdopen($tty,">") or &handle_error("STDOUT: ".($!)); # Save Pound Sign
STDERR->fdopen($tty,">") or &handle_error("STDERR: ".($!)); # Save Pound Sign
CORE::close $tty; # Save Pound Sign
$| = 1; # Save Pound Sign
#my $flag=''; # Save Pound Sign
#if (!$flag || lc($flag) ne '__use_parent_env__') {
if ($^O ne 'cygwin' && $Net::FullAuto::FA_Core::specialperms eq 'setgid') {
$ENV{PATH} = ''; # Save Pound Sign
$ENV{ENV} = ''; # Save Pound Sign
} else {
$ENV{PATH}=~/^(.*)$/; # Save Pound Sign
$ENV{PATH}=$1; # Save Pound Sign
$ENV{ENV}||=''; # Save Pound Sign
$ENV{ENV}=~/^(.*)$/; # Save Pound Sign
$ENV{ENV}=$1; # Save Pound Sign
}
$ENV{DISPLAY}=''; # Save Pound Sign
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";
my ($ip,$hostlabel,$hostname,$info,$apache_handle,$ua)=@_;
my @info=@{$info};
my %apache_handle=%{$apache_handle};
my %ua=%{$ua};
my $username=&Net::FullAuto::FA_Core::username();
my $an='';
eval {
#$apache_handle{$info[2]} = new LWP::UserAgent;
#print "GP1\n";
$apache_handle{$info[2]}->credentials(
$an,'WebRSH',$username,&getpasswd($hostlabel,$username));
$apache_handle{$info[2]}->agent(
"$progname " . $ua->agent);
};
if ($@) {
return $@;
}
}
sub test_file
{
my ($cmd_handle,$tfile)=@_;my $test_result=0;
my $shell_cmd="if\n[[ -f $tfile ]]\nthen\nif\n[[ -w $tfile ]]"
."\nthen\necho WRITE\nelse\necho READ\nfi\n"
."else\necho NOFILE\nfi";
my ($stdout,$stderr)=('','');
($stdout,$stderr)=$cmd_handle->cmd($shell_cmd);
return $stdout;
}
sub test_dir
{
my ($cmd_handle,$tdir)=@_;my $test_result=0;
my $shell_cmd='';
if (-1<index $ENV{'SHELL'},'bash') {
$shell_cmd="if\n[[ -d $tdir ]]\nthen\nif\n[[ -w $tdir ]]"
."\nthen\necho WRITE\nelse\necho READ\nfi\n"
."else\necho NODIR\nfi";
} else {
$shell_cmd="if [ -d $tdir ]; then\nif [ -w $tdir ];"
." then\necho WRITE\nelse\necho READ\nfi\n"
."else\necho NODIR\nfi";
}
my ($stdout,$stderr,$retcod);
($stdout,$stderr,$retcod)=$cmd_handle->cmd($shell_cmd);
return $stdout;
}
sub inc_oct
{
my $num=$_[0];
while (1) {
$num++;
return $num if (-1==index $num,'8') && (-1==index $num,'9')
}
}
sub get_prompt {
unless ($#ascii_que) {
@ascii_que=@ascii;
} return shift @ascii_que;
}
sub clean_filehandle
{
my @topcaller=caller;
print "\nINFO: main::clean_filehandle() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::clean_filehandle() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $filehandle=$_[0];
my $cftimeout=$_[1]||0;
my $command=$_[2]||'';
if (!defined $filehandle || -1==index $filehandle,'GLOB'
|| !defined fileno $filehandle) {
if (defined $filehandle && (-1==index $filehandle,'GLOB')) {
eval {
$filehandle=$filehandle->{_cmd_handle};
$filehandle=$filehandle->{_cmd_handle}->{_cmd_handle}
if exists $filehandle->{_cmd_handle}->{_cmd_handle} &&
(-1==index $filehandle,'GLOB');
};
if (($@ && -1==index $filehandle,'GLOB') ||
!defined fileno $filehandle) {
if (wantarray) {
&release_fa_lock(7755);
return '','Invalid filehandle';
} else {
&release_fa_lock(7755);
&Net::FullAuto::FA_Core::handle_error($@.
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
}
} else {
if (wantarray) {
if ($cftimeout) {
&release_fa_lock(7755);
my $die='';
if ($command) {
$die=<<END;
The Command:
$command
did not complete before timeout => $timeout seconds.
This is common if the command takes more than $timeout
seconds to complete, and/or no output is generated
within $timeout seconds.
END
} else {
$die=<<END;
Command did not complete before timeout => $timeout seconds.
This is common if the command takes more than $timeout
seconds to complete, and/or no output is generated
within $timeout seconds.
END
}
$die.=<<END;
Increase the timeout for the command, or if it is a script
or program you authored, consider adding verbose output
that appears before the timeout of $timeout seconds expires.
END
return $die;
} else {
&release_fa_lock(7755);
return '','Invalid filehandle';
}
} else {
&release_fa_lock(7755);
&Net::FullAuto::FA_Core::handle_error(
"$filehandle is NOT a valid filehandle".
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
}
} my $loop=0;my $sec=0;my $ten=0;my $hun=5;my $closederror='';
while (1) {
$Net::FullAuto::FA_Core::uhray=&Net::FullAuto::FA_Core::get_prompt();
$filehandle->print(' cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
if ($loop==100) {
my $die="100 attempts without indication that filehandle is clean";
if (wantarray) {
&release_fa_lock(7755);
return '',$die;
} else {
&release_fa_lock(7755);
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
}
}
my $wait=$sec.'.'.$ten.$hun;
if ($wait!=3.00) {
if ($hun==9) {
if ($ten==9) {
$sec++;$ten=0;$hun=0;
} else {
$ten++;$hun=0;
}
} else { $hun++ }
}
select(undef,undef,undef,$wait)
if $loop++!=1; # sleep;
my $eval_out='';my $eval_err='';
($eval_out,$eval_err)=eval {
my $all_lines='';my $loop2=0;
while (my $line=$filehandle->get(Timeout=>30)) {
#print "CLEAN_LINE=$line and ${$Net::FullAuto::FA_Core::uhray}[0]_-<==\n";
print $Net::FullAuto::FA_Core::LOG "\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::LOG,'*';
$line=~tr/\0-\11\13-\37\177-\377//d;
chomp($line);
$all_lines.=$line;
if ($line=~/password[: ]+$/si) {
return '',$line;
} elsif (-1<index $all_lines,
"$Net::FullAuto::FA_Core::uhray->[0]_-") {
if ($all_lines=~/_funkyPrompt_$/s) {
return '','';
} else {
last;
}
} elsif (-1<index $all_lines,'Exit status') {
$closederror='Exit status 0';
last;
} elsif (
$all_lines=~/(Conn.*reset|Conn.*closed|filehandle.*isn)/s) {
$closederror=$1;
last;
} elsif ($loop2==100) {
my $die="100 attempts without indication ".
"that filehandle is clean";
if (wantarray) {
&release_fa_lock(7755);
return '',$die;
} else {
&release_fa_lock(7755);
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__')
}
}
$wait=$sec.'.'.$ten.$hun;
if ($wait!=3.00) {
if ($hun==9) {
if ($ten==9) {
$sec++;$ten=0;$hun=0;
} else {
$ten++;$hun=0;
}
} else { $hun++ }
}
select(undef,undef,undef,$wait)
if $loop2++!=1; # sleep;
}
};
if ($@) {
if (wantarray) {
&release_fa_lock(7755);
return '',$@;
} else {
&release_fa_lock(7755);
&Net::FullAuto::FA_Core::handle_error($@.
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
} elsif ($eval_err && $eval_err=~/password[: ]+$/si) {
return '',$eval_err;
} elsif ($closederror) {
if (wantarray) {
&release_fa_lock(7755);
return '',$closederror;
} else {
&release_fa_lock(7755);
&Net::FullAuto::FA_Core::handle_error($closederror.
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
} else {
&release_fa_lock(7755);
select(undef,undef,undef,0.02);
# sleep for 1/50th second;
return '',''
}
}
} ## END of &clean_filehandle
sub attempt_cmd_xtimes
{
my @topcaller=caller;
print "\nINFO: main::attempt_cmd_xtimes() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "\nmain::attempt_cmd_xtimes() (((((((CALLER))))))):",
"\n ",(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cmd_handle=$_[0];
my $cmd=$_[1];
my $num_of_attempts=$_[2]||100;
my $stdout='';my $stderr='';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
if (-1==index $cmd_handle,'GLOB' || !defined fileno $cmd_handle) {
if (-1==index $cmd_handle,'GLOB') {
eval {
$cmd_handle=$cmd_handle->{_cmd_handle};
$cmd_handle=$cmd_handle->{_cmd_handle}->{_cmd_handle}
if -1==index $cmd_handle,'GLOB';
};
if (($@ && -1==index $cmd_handle,'GLOB') ||
!defined fileno $cmd_handle) {
if (wantarray) {
return '','Connection closed';
} else {
&Net::FullAuto::FA_Core::handle_error($@,'__cleanup__')
}
}
} else {
if (wantarray) {
return '','Connection closed';
} else {
&Net::FullAuto::FA_Core::handle_error(
"$cmd_handle is NOT a valid filehandle",'__cleanup__')
}
}
}
my $hostlabel=$_[2];
my $cou=100;
while ($cou--) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
$cmd,'__live__');
print "\nOUTPUT FROM \" attempt_cmd_xtimes()\" (problamatic cmds that often need to be tried",
" more than once):\n ==>$stdout<== at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
if (!$stdout) {
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
$cfh_error||='Not a GLOB reference' if $cou==1;
&handle_error($cfh_error,'-1') if $cfh_error;
select(undef,undef,undef,0.02);
$cmd_handle->print(' '.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;$cmd;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');
my $allins='';my $ct=0;
while (my $line=$cmd_handle->get) {
$line=~tr/\0-\37\177-\377//d;
chomp($line);
$allins.=$line;
#print "PUSH_CMD_LINE_QQQQQQQQQQQ=$allins<== AND LINE=$line<==\n";
print $Net::FullAuto::FA_Core::LOG "PUSH_CMD_LINE_QQQQQQQQQQQ=$allins<== AND LINE=$line<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($allins=~/!!(.*)%%/) {
$stdout=$1;
last;
} else {
$cmd_handle->
print(' '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\055');
}
if ($ct++==10) {
$cmd_handle->print;
last;
}
}
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
} else { last }
}
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
return $stdout;
}
sub master_transfer_dir
{
my $localhost=$_[0];
my $tdir='';my $transfer_dir='';my $curdir='';my $retcod='';
my $output='';my $stderr='';my $work_dirs={};my $endp=0;my $testd='';
while (1) {
if ($^O eq 'cygwin') {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
$cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$work_dirs->{_pre}=$curdir.'/' if $curdir ne '/';
$work_dirs->{_pre_mswin}=$cdr.'\\\\';
} else {
($curdir,$stderr)=$localhost->cmd('pwd');
$work_dirs->{_pre}=$curdir.'/' if $curdir ne '/';
}
if (!$curdir || $curdir=~/^\s*$/s ||
256<length $curdir || $curdir=~/\n/s) {
print "\nWARNING: PROBLEMS ACQUIRING CURRENT DIRECTORY ",
"(TRYING AGAIN):",
" ==>$curdir<== ".
" at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nWARNING: PROBLEMS ACQUIRING CURRENT DIRECTORY (TRYING AGAIN):",
" ==>$curdir<== ".
" at Line ",__LINE__,"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
next;
}
last if $curdir;
}
if (exists $Hosts{"__Master_${$}__"}{'TransferDir'}) {
$master_transfer_dir=$tdir=$Hosts{"__Master_${$}__"}{'TransferDir'};
if ($^O eq 'cygwin' && $tdir=~/^[\\|\/]/
&& $tdir!~/$localhost->{_cygdrive_regex}/o) {
if (($work_dirs->{_tmp},$work_dirs->{_tmp_mswin})
=&File_Transfer::get_drive(
$tdir,'Destination','',"__Master_${$}__")) {
$testd=&test_dir($localhost,$work_dirs->{_tmp});
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.${Net::FullAuto::FA_Core::work_dirs}{_tmp});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin};
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}.'/';
} else {
&Net::FullAuto::FA_Core::handle_error(
'TransferDir not Writable');
}
}
} elsif ($tdir=~/^[a-zA-Z]:/) {
if ($^O eq 'cygwin') {
my ($drive,$path)=unpack('a1 x1 a*',$tdir);
$path=~tr/\\/\//;
${$work_dirs}{_cwd}=$localhost->{_cygdrive}
.'/'.lc($drive).$path.'/';
$testd=&test_dir($localhost,${$work_dirs}{_cwd});
if ($testd eq 'WRITE') {
if ($tdir ne $curdir) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_cwd});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$work_dirs->{_cwd_mswin}=$tdir.'\\';
} else {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin};
$work_dirs->{_cwd}=$work_dirs->{_pre};
}
$work_dirs->{'_tmp_mswin'}=$work_dirs->{'_cwd_mswin'};
$master_transfer_dir=$work_dirs->{'_tmp'}=$work_dirs->{'_cwd'};
return $work_dirs;
} else {
&Net::FullAuto::FA_Core::handle_error(
"TransferDir not Writable and TESTD=$testd<==".
" and work_dirs-_cwd=$work_dirs->{_cwd}<==");
}
}
my $warn="Cannot cd to $tdir\n\tOperating " .
"System is $^O - NOT cygwin!";
warn "$warn $!";
} $tdir=~tr/\\/\//;
$testd=&test_dir($localhost,$tdir);
if ($testd eq 'WRITE') {
my $drive='';my $path='';
if ($^O eq 'cygwin') {
$tdir=~s/$localhost->{_cygdrive_regex}//;
($drive,$path)=unpack('a1 a*',$tdir);
$tdir=$drive.':'.$path;
$tdir=~tr/\//\\/;
$tdir=~s/\\/\\\\/g;
}
if ($tdir ne $curdir) {
if ($^O eq 'cygwin') {
$work_dirs->{_cwd}=$localhost->{_cygdrive}
.'/'.lc($drive).$path.'/';
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_cwd});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$work_dirs->{_cwd_mswin}=$tdir.'\\';
} else {
($output,$stderr)=$localhost->cmd("cd $tdir");
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$work_dirs->{_cwd}=$tdir.'/';
}
} else {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin}
if $^O eq 'cygwin';
$work_dirs->{_cwd}=$work_dirs->{_pre};
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin}
if $^O eq 'cygwin';
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};
return $work_dirs;
}
}
if ($^O eq 'cygwin') {
($output,$stderr)=$localhost->cmd("cd /tmp");
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nTTTTTTT cd /tmp TTTTTTT OUTPUT ==>$output<== ",
"and STDERR ==>$stderr<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
if (!$stderr || ($stderr=~/^.*cd \/tmp 2[>][&]1$/)) {
my $cnt=2;
while ($cnt--) {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
$cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$testd=&test_dir($localhost,$curdir);
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nDDDDDDD &test_dir of $curdir DDDDDDD OUTPUT ==>$testd<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin}=$cdr.'\\\\';
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$curdir.'/';
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};
return $work_dirs;
} elsif ($testd eq 'READ' || $testd eq 'NOFILE') {
last;
} else {
($output,$stderr)=$localhost->cmd('cd -')
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
}
}
if ((${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
'/tmp','Destination','',"__Master_${$}__")) {
$testd=&test_dir($localhost,$work_dirs->{_tmp});
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_tmp});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin};
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};
return $work_dirs;
}
}
if (($work_dirs->{_tmp},$work_dirs->{_tmp_mswin})
=&File_Transfer::get_drive(
'/temp','Destination','',"__Master_${$}__")) {
$testd=&test_dir($localhost,$work_dirs->{_tmp});
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_tmp});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin};
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};
return $work_dirs;
}
}
($output,$stderr)=$localhost->cmd("cd $home_dir");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
if (!$stderr) {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
$cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\//\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$testd=&test_dir($localhost,$curdir);
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin}=$cdr.'\\';
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$curdir.'/';
return $work_dirs;
} else {
($output,$stderr)=$localhost->cmd('cd -')
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
}
$testd=&test_dir($localhost,$curdir);
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin};
$work_dirs->{_tmp_mswin}=$work_dirs->{_pre_mswin};
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$work_dirs->{_pre};
return $work_dirs;
} else {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!";
&handle_error($die,'__cleanup__');
}
} $testd=&test_dir($localhost,'/tmp');
if ($testd eq 'WRITE') {
($output,$stderr,$retcod)=$localhost->cmd('cd /tmp')
if '/tmp' ne $curdir;
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}='/tmp/';
return $work_dirs;
} $testd=&test_dir($localhost,$home_dir);
if ($testd eq 'WRITE') {
($output,$stderr,$retcod)=$localhost->cmd("cd $home_dir")
if $home_dir ne $curdir;
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}=$home_dir.'/';
return $work_dirs;
}
$testd=&test_dir($localhost,$curdir);
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nDDDDDDD &test_dir of $curdir DDDDDDD OUTPUT ==>$testd<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if ($testd eq 'WRITE') {
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}=$curdir.'/';
return $work_dirs;
} else {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!";
&handle_error($die,'__cleanup__');
}
}
sub master_transfer_dir_no_telnet_login
{
#my $transfer_dir='';
my $curdir=Cwd::getcwd();
if (exists $Hosts{"__Master_${$}__"}{'TransferDir'}
&& -d $Hosts{"__Master_${$}__"}{'TransferDir'}
&& -w _) {
$master_transfer_dir=$Hosts{"__Master_${$}__"}{'TransferDir'};
if (unpack('x1 a1',"$master_transfer_dir") eq ':') {
my ($drive,$path)=unpack('a1 @2 a*',$master_transfer_dir);
$path=~tr/\\/\//;
$master_transfer_dir=$localhost->{_cygdrive}."/$drive$path/";
}
} elsif ($^O ne 'cygwin' &&
$^O ne 'MSWin32' &&
$^O ne 'MSWin64' &&
$ENV{OS} ne 'Windows_NT' &&
-d '/tmp' && -w _) {
$master_transfer_dir="/tmp/";
} elsif ($^O eq 'cygwin' &&
-d $localhost->{_cygdrive}.'/c/tmp' && -w _) {
$master_transfer_dir=$localhost->{_cygdrive}.'/c/tmp/';
} elsif ($^O eq 'cygwin' &&
-d $localhost->{_cygdrive}.'/c/temp' && -w _) {
$master_transfer_dir=$localhost->{_cygdrive}.'/c/temp/';
} elsif (-d $home_dir && -w _) {
$master_transfer_dir=$home_dir;
if (unpack('@1 a1',$master_transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$master_transfer_dir);
$path=~tr/\\/\//;
$master_transfer_dir=$localhost->{_cygdrive}.'/'.lc($drive).$path.'/';
}
} elsif (!(-w $curdir)) {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!\n";
print $die if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::LOG $die if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} else {
print "GETTING CURDIR FOR TRANSFER=",cwd(),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "GETTING CURDIR FOR TRANSFER=",cwd(),"\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$master_transfer_dir=$curdir;
}
$localhost->{_cwd}{_cwd}=Cwd::getcwd().'/';
return $master_transfer_dir;
}
sub getpasswd
{
#print "GETPASSCALLER=",caller,"\n";sleep 4;
my @topcaller=caller;
print "\nINFO: main::getpasswd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::getpasswd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $mr="__Master_".$$."__";
unless (exists $Hosts{$mr}) {
$mr="__Master_".getppid."__";
}
my $hostlabel=$_[0]||$mr;
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel);
my $host='';
my $sshport='';
if (exists $Hosts{$hostlabel}{'sshport'}) {
$sshport=$Hosts{$hostlabel}{'sshport'};
}
$login_id=$_[1] if $_[1];
my $force=0;my $su_login=0;
my $errmsg='';
my $track='';my $prox='';
my $pass='';my $save_passwd='';
my $cmd_type='';my $status='';
my $encrypted_passwd='';
my $bdb='';
my $username=&Net::FullAuto::FA_Core::username();
if (defined $_[2] && $_[2]) {
if ($_[2] eq '__force__') {
$force=1;
} elsif ($_[2] eq '__su__') {
$su_login=1;
} else {
$ms_domain=$_[2];
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__force__') {
$force=1;
} elsif ($_[3] eq '__su__') {
$su_login=1;
} else {
$errmsg=$_[3];
$errmsg=~s/\s+$//s;
$errmsg.="\n";
$force=1;
}
}
if (defined $_[4] && $_[4]) {
if ($_[4] eq '__force__') {
$force=1;
} elsif ($_[4] eq '__su__') {
$su_login=1;
} else {
$track=$_[4];
}
}
if (defined $_[5] && $_[5]) {
if ($_[5] eq '__force__') {
$force=1;
} elsif ($_[5] eq '__su__') {
$su_login=1;
} else {
$cmd_type=$_[5];
}
}
if (defined $_[6] && $_[6]) {
if ($_[6] eq '__force__') {
$force=1;
} elsif ($_[6] eq '__su__') {
$su_login=1;
}
}
if (defined $_[7] && $_[7]) {
if ($_[7] eq '__force__') {
$force=1;
} elsif ($_[7] eq '__su__') {
$su_login=1;
}
}
my $cipher='';
if ($passetts->[0]) {
if ($Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
}
if (!$hostlabel) {
my $herr="HOSTLABEL or LABEL needed for first arguement to &getpasswd()"
."\n\n Called from ".(caller(0))[1]." line "
.(caller(0))[2]." :\n ";
&handle_error($herr.($!));
}
my $key='';
my $local_host_flag=0;my $href='';
my $label_for_db=$hostlabel;
my $passlabel=$hostlabel;
if ((exists $same_host_as_Master{$hostlabel} && !$sshport) ||
($hostlabel eq $mr)) {
return $local_pw if $local_pw;
$local_host_flag=1;
$label_for_db="localhost_$username";
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq $mr;
$passlabel=$hostlab;
last;
}
$passlabel='localhost' if $passlabel eq $hostlabel;
}
if ($Net::FullAuto::FA_Core::plan) {
#my $pl=$Net::FullAuto::FA_Core::plan->{Number};
#print "WHAT IS PL=$pl<==\n";<STDIN>;
if ($local_host_flag && $username eq $login_id) {
$key="${username}_X_${localhost}_X_${$}_X_$invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${hostlabel}_X_${cmd_type}";
} else {
$key="${username}_X_${login_id}_X_${hostlabel}";
}
} else {
if ($local_host_flag && $username eq $login_id) {
$key="${username}_X_${localhost}_X_${$}_X_$invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${hostlabel}_X_${cmd_type}";
} else {
$key="${username}_X_${login_id}_X_${hostlabel}";
}
}
if ($Net::FullAuto::FA_Core::scrub) {
unless ($Net::FullAuto::FA_Core::tosspass) {
&scrub_passwd_file($hostlabel,$login_id)
} else {
delete $Net::FullAuto::FA_Core::tosspass{$key};
}
$force=1;
}
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
my $tie_err="can't open tie to "
. $Hosts{$mr}{'berkeley_db_path'}
."${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";
unless ($Net::FullAuto::FA_Core::tosspass) {
print $LOG "PASSWDDB=",
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db","<==\n"
if -1<index $LOG,'*';
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
$status=$bdb->db_get($label_for_db,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
$href||={};
print $LOG "HREF=$href and KEY=$key and KEYS=",
(join "\n",keys %{$href}),"<==\n"
if -1<index $LOG,'*';
if (exists $href->{$key} && !$force) {
my $pspath=$Net::FullAuto::FA_Core::gbp->('ps');
my $stdout='';my $stderr='';
($stdout,$stderr)=
&Net::FullAuto::FA_Core::cmd(
"${pspath}ps -e",'__escape__');
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__')
if $stderr;
my $encrypted_passwd=$href->{$key};
foreach my $ky (keys %{$href}) {
if ($ky=~/_X_(\d+)_X_\d+$/) {
my $one=$1;
delete $href->{$ky} if (-1==index $stdout,$one);
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($label_for_db,$put_href);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
$pass='';
eval {
$pass=$cipher->decrypt($encrypted_passwd);
# Dont' know why this was here
chop $pass if $pass eq substr($pass,0,(rindex $pass,'.')).'X'
&& $^O eq 'cygwin';
};
# --CONTINUE-- print "WHAT IS PASS=$pass<====\n";
# print "WHAT IS PASS=$pass<==== and PASSLABEL=$passlabel\n";sleep 5;
return $pass if $pass && $pass!~tr/\0-\37\177-\377//;
if (!$pass && $oldpasswd) {
my $cipher = new Crypt::CBC($oldpasswd,
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
$save_passwd=$cipher->decrypt($encrypted_passwd);
}
} elsif (exists $href->{"gatekeep_$username"}) {
$save_passwd=$Net::FullAuto::FA_Core::gatekeep->(
$href,$username,$bdb,$dbenv,$label_for_db,0,$errmsg);
} elsif (keys %{$href}) {
foreach my $ky (keys %{$href}) {
if ($ky=~/_X_(\d+)_X_\d+$/) {
unless (&Net::FullAuto::FA_Core::testpid($1)) {
delete $href->{$ky}
unless &Net::FullAuto::FA_Core::testpid($1);
}
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($label_for_db,$put_href);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
} else {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
&scrub_passwd_file($hostlabel,$login_id) if
$errmsg=~/Permission denied|[Pp]assword:/s;
# SCRUB PROBLEM;
} elsif (!$force && (exists $Net::FullAuto::FA_Core::tosspass{$key})) {
$save_passwd=$Net::FullAuto::FA_Core::tosspass{$key};
}
if (!$save_passwd) {
if ($Net::FullAuto::FA_Core::cron) {
if ($Net::FullAuto::FA_Core::tosspass) {
my $die="\n\nBoth 'cron' and 'tosspass' Conditions"
." Active.\n\n Hostlabel: "
." $passlabel\n Login ID: $login_id\n "
." Needed For: $host\n\n "
." &getpasswd() Called from ".(caller(0))[1]." line "
.(caller(0))[2]."\n"
."\n - 'cron' and 'tossposs' are incompatible "
."conditions "
."\n and cannot be specified together for any "
."FullAuto "
."\n invocation.\n";
&handle_error($die,'',$track);
return '',$die;
} elsif ($host) {
my $die="Invalid Password Stored for\n\n Hostlabel: "
." $passlabel\n Login ID: $login_id\n "
." Needed For: $host\n\n "
." &getpasswd() Called from ".(caller(0))[1]." line "
.(caller(0))[2]."\n"
."\n - Run $Net::FullAuto::FA_Core::progname outside "
."of cron and enter "
."\n the correct Password when prompted.\n";
&handle_error($die,'',$track);
return '',$die;
} else {
my $die="Invalid Password Stored for\n\n Label:"
." $passlabel\n Login ID: $login_id"
."\n\n "
."&getpasswd() Called from ".(caller(0))[1]." line "
.(caller(0))[2]."\n"
."\n - Run $Net::FullAuto::FA_Core::progname "
."outside of cron and enter "
."\n the correct Password when prompted.\n";
&handle_error($die,'',$track);
return '',$die;
}
}
my $loop_count=0;
while (1) {
$loop_count++;
print $blanklines;
my $errm=$errmsg;
$errm=~s/^(.*) (at .*)$/$1\n $2/s;
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n ERROR MESSAGE (1) -> $errm";
} else {
print "\n ERROR MESSAGE -> $errm";
}
}
my $print1='';
if ($ms_domain) {
if ($local_host_flag) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (1) the MS Domain password for "
.$login_id
."\n (Needed for Local Host \'$passlabel\' - $host)"
."\n";
} else {
$print1="\n Please Enter the MS Domain password for "
.$login_id
."\n (Needed for Local Host \'$passlabel\' - $host)"
."\n";
}
} elsif ($host) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (2) the MS Domain password "
."for $login_id"
."\n (Needed for HostLabel \'$passlabel\' - $host)\n";
} else {
$print1="\n Please Enter the MS Domain password for "
.$login_id
."\n (Needed for HostLabel \'$passlabel\' - $host)\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (3) authentication password."
."\n (Needed for Label \'$passlabel\')\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for Label \'$passlabel\')\n";
}
}
} elsif ($login_id eq 'root') {
if ($local_host_flag) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (4) the \'root\' password "
."for $host."
."\n (Needed for "
."HostLabel \'$passlabel\')\n";
} else {
$print1="\n Please Enter the \'root\' password for $host."
."\n (Needed for "
."HostLabel \'$passlabel\')\n";
}
} elsif ($host) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (5) the \'root\' password "
."for $host."
."\n (Needed for HostLabel \'$passlabel\')\n";
} else {
$print1="\n Please Enter the \'root\' password for $host."
."\n (Needed for HostLabel \'$passlabel\')\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (6) authentication password."
."\n (Needed for Label \'$passlabel\')\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for Label \'$passlabel\')\n";
}
}
} else {
if ($local_host_flag) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (7) $login_id\'s "
."password for $host."
."\n (Needed for ${prox}Local Host \'$passlabel\')\n";
} else {
$print1="\n Please Enter $login_id\'s password for $host."
."\n (Needed for ${prox}Local Host \'$passlabel\')\n";
}
} elsif ($host) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (8) $login_id\'s password "
."for $host."
."\n (Needed for ${prox}HostLabel \'$passlabel\')\n";
} else {
$print1="\n Please Enter $login_id\'s password for $host."
."\n (Needed for ${prox}HostLabel \'$passlabel\')\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (9) authentication password."
."\n (Needed for ${prox}Label \'$passlabel\')\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for ${prox}Label \'$passlabel\')\n";
}
}
}
my $passwd_timeout=350;
my $te_time=time;
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
local $SIG{INT} = sub { die "int\n" };
alarm($passwd_timeout);
&acquire_fa_lock(9854);
print $print1;
if ($Net::FullAuto::FA_Core::debug) {
print "\n Password (1): ";
} else {
print "\n Password: ";
}
ReadMode 2;
$save_passwd=<STDIN>;
&release_fa_lock(9854);
};alarm(0);
ReadMode 0;
if ($@ eq "alarm\n" or $@ eq "int\n") {
print "\n\n";
$errmsg.="\n\n ".
"Time Allowed for Password Input has Expired.\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error') {
my $body='';
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
$body="\n ERROR MESSAGE (2) -> $errmsg";
} else {
$body="\n ERROR MESSAGE -> $errmsg";
}
}
$body.=$print1;my $subject='';
if ($host) {
$subject="Login Failed for $login_id on $host";
} else {
$subject="Authentication Failed";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);
&Net::FullAuto::FA_Core::send_email(\%mail);
}
if ($@ eq "alarm\n") {
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');
} else {
&handle_error(
"Interupt Signal Received - FullAuto will exit",
'__cleanup__');
}
}
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";
}
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
ReadMode 0;
chomp($save_passwd);
print "\n\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error') {
my $body='';
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
$body="\n ERROR MESSAGE (3) -> $errmsg";
} else {
$body="\n ERROR MESSAGE -> $errmsg";
}
}
$body.=$print1;my $subject='';
if ($host) {
$subject="Login Failed for $login_id on $host";
} else {
$subject="Authentication Failed";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);
&Net::FullAuto::FA_Core::send_email(\%mail);
}
last if $save_passwd;
}
}
unless ($Net::FullAuto::FA_Core::tosspass) {
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
$status=$bdb->db_get($label_for_db,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
while (delete $href->{$key}) {}
$save_passwd.='X' if $save_passwd
eq substr($Net::FullAuto::FA_Core::progname,0,
(rindex $Net::FullAuto::FA_Core::progname,'.'));
my $cipher='';
if ($Net::FullAuto::FA_Core::dcipher) {
if ($Hosts{$mr}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
if (8<length $Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
my $new_encrypted=$cipher->encrypt($save_passwd);
$href->{$key}=$new_encrypted;
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($label_for_db,$put_href);
} else {
$passetts->[1]=$Net::FullAuto::FA_Core::choose_pass_expiration->();
my $rstr=new String::Random;
if ($Hosts{$mr}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $cipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
$mr}{'Cipher'});
$passetts->[0]=$cipher->encrypt($save_passwd);
$passetts->[2]=$dcipher=$cipher;
$Net::FullAuto::FA_Core::save_main_pass=1;
undef $passwd[0];
my @tpass=@{$passetts}[0..1];
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump(\@tpass)->Out();
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($label_for_db,$put_href);
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
} else {
$Net::FullAuto::FA_Core::tosspass{$key}=$save_passwd;
}
return $save_passwd;
}
sub chgdir
{
my $pwd='';my $destdir=$_[1];
my $cmd_handle=$_[0];
$cmd_handle->cmd("cd $destdir");
($pwd)=$cmd_handle->cmd('pwd');
$pwd=~s/^(.*)?{\n}.*$/$1/;
chomp($pwd);
#print "PWD=$pwd and DEST=$_[1]\n";<STDIN>;
if ($pwd eq $_[1] or "$pwd/" eq "$_[1]") { return 1 }
else {
print "FATAL ERROR! The directory \"$_[1]\" does NOT exist!";
return 0;
}
}
sub runcmd # USAGE: &runcmd(FileHandle, "command_to_run_string")
{
my @output=${$_[0]}->cmd($_[1]);
foreach (@output) {
if (/Execute permiss/) {
print "FATAL ERROR! Execute permission denied for command:";
print "--> $_[1]\n";
return 0;
}
} return \@output;
}
sub check_if_websphere_is_running
{
my ($cmd_handle,$applic)=@_;
return if $websphere_not_running==1;
my @ls=$cmd_handle->cmd("ls -C1 /usr/WebSphere/AppServer/bin");
my $wscp_UX||='';
@ls=grep { /^wscp/ } @ls;
print "--> Verifying that WebSphere is Offline ...\n";
my $wscp_sub = sub {
my $wscp_copy=$wscp_UX;
substr($wscp_copy,(index $wscp_UX,'__JVM__'),7)=$_[1];
#&chgdir($cmd_handle,"/usr/WebSphere/AppServer/bin")
# || handle_error(
# "Cannot &chgdir /usr/WebSphere/AppServer/bin");
my ($output,$stderr)=$cmd_handle->cwd(
"/usr/WebSphere/AppServer/bin");
&handle_error($stderr,'-1') if $stderr;
my $app='';
$output=&runcmd($_[0],$wscp_copy) ||
&handle_error("Cannot &runcmd $wscp_copy");
my @output=@{$output};
if ($applic eq 'member') { $app='Empire' }
elsif ($applic eq 'provider') { $app='Provider' }
foreach (@output) {
if (/Running|Initializing/ &&
(($app eq 'Empire' && /(EmpireServer.*)}/m) ||
($app eq 'Provider' && /(ProviderServer.*)}/m))) {
my $serv="";($serv=$1)=~s/}.*$//;
my $die="\n FATAL ERROR! - \"$serv\" is RUNNING!\n\n";
print $die if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
}
}
};
foreach (@ls) {
chomp;
my $num='';
($num=$_)=~s/^wscp(\d+)\.sh$/$1/;
$num='' if substr($num,0,4)=='wscp';
$wscp_sub->($cmd_handle,$num);
} $websphere_not_running=1;
}
sub apache_download
{
$| = 1; # autoflush
my $ua = new LWP::UserAgent;
my ($file,$host,$hostlabel)=@_;
my ($size,$start_t,$length,$flength,$last_dur)='';
$ua->agent("$progname " . $ua->agent);
my $username=&Net::FullAuto::FA_Core::username();
#print "GP3\n";
$ua->credentials("$Hosts{\"__Master_${$}__\"}{'IP'}:80",'WebRSH',
"$username",&getpasswd($hostlabel,$username));
$ua->env_proxy;
my $url="http://${$ApacheNode[0]}[0]/download/$_[0]";
my $req = new HTTP::Request GET => $url;
my $shown = 0; # have we called the show() function yet
my $res = $ua->request($req,
sub {
my $res = $_[1];
open(FILE, ">$file") ||
&handle_error("Can't open $file: ");
binmode FILE;
$length = $res->content_length;
$flength = fbytes($length) if defined $length;
$start_t = time;
$last_dur = 0;
$size += length($_[0]);
print FILE $_[0];
if (defined $length) {
my $dur = time - $start_t;
if ($dur != $last_dur) { # don't update too often
$last_dur = $dur;
my $perc = $size / $length;
my $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
my $secs_left = fduration($dur/$perc - $dur);
$perc = int($perc*100);
my $show = "$perc% of $flength";
$show .= " (at $speed, $secs_left remaining)" if $speed;
show($show, 1);
}
} else {
show( fbytes($size) . " received");
}
}
);
if ($res->is_success || $res->message =~ /^Interrupted/) {
show("");
print "\r";
print fbytes($size);
print " of ", fbytes($length) if defined($length) && $length != $size;
print " received";
my $dur = time - $start_t;
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
if ($dur) {
my $speed = fbytes($size/$dur) . "/sec";
print " in ", fduration($dur), " ($speed)";
}
print "\n";
}
my $died = $res->header("X-Died");
if ($died || !$res->is_success) {
if (-t) {
print "Transfer aborted. Delete $file? [n] ";
my $ans = <STDIN>;
unlink($file) if defined($ans) && $ans =~ /^y\n/;
} else {
print "Transfer aborted, $file kept\n";
}
}
} else {
print "\n" if $shown;
print "${Net::FullAuto::FA_Core::progname}.pl: ", $res->status_line, "\n";
exit 1;
}
}
sub fbytes
{
my $n = int(shift);
if ($n >= 1024 * 1024) {
return sprintf "%.3g MB", $n / (1024.0 * 1024);
} elsif ($n >= 1024) {
return sprintf "%.3g KB", $n / 1024.0;
} else {
return "$n bytes";
}
}
sub fduration
{
use integer;
my $secs = int(shift);
my $hours = $secs / (60*60);
$secs -= $hours * 60*60;
my $mins = $secs / 60;
$secs %= 60;
if ($hours) {
return "$hours hours $mins minutes";
} elsif ($mins >= 2) {
return "$mins minutes";
} else {
$secs += $mins * 60;
return "$secs seconds";
}
}
BEGIN {
my @ani = qw(- \ | /);
my $ani = 0;
sub show
{
my($mess, $show_ani) = @_;
print "\r$mess" . (" " x (75 - length $mess));
print $show_ani ? "$ani[$ani++]\b" : " ";
$ani %= @ani;
$shown++;
}
}
sub Net::Telnet::select_dir
{
print "NetSELECTDIRCALLER=",caller,"\n";#<STDIN>;
return File_Transfer::select_dir(@_);
}
sub Net::Telnet::diff
{
return File_Transfer::diff(@_);
}
sub Net::Telnet::mirror
{
return File_Transfer::mirror(@_);
}
sub send_email
{
my @topcaller=caller;
print "\nINFO: main::send_email() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::send_email() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $usage='notify_on_error';my $mail_module='Mail::Sender';
my $mail_method='';my $mail_server='';my $mail_port='';
my $bcc='';my $cc='';my $content_type='';my $priority='';
my $content_transfer_encoding='';my $content_disposition='';
my $date='';my $from='';my $keywords='';my $message_id='';
my $mime_version='';my $organization='';my $received='';
my $references='';my $reply_to='';my $resent_from='';
my $return_path='';my $sender='';my $subject='';my $body='';
my $to='';my $sendemail=0;my $done_warning=0;my $transport='';
my $head='';my $mail_sender='';my %mail_sender_defaults=();
my $mail_info=$_[0];my $ent='';
my $warn=1 if grep { lc($_) eq '__warn__' } @_;
my $username=&Net::FullAuto::FA_Core::username();
#tie *debug, "Net::FullAuto::MemoryHandle";
if (ref $mail_info eq 'HASH') {
if (exists $mail_info->{Usage}) {
$usage=$mail_info->{Usage};
} elsif ($email_defaults &&
(exists $email_defaults{Usage})) {
$usage=$email_defaults{Usage};
}
if ($usage ne 'notify_on_error'
&& (caller(1))[3] eq 'FA_Core::handle_error') {
return 0;
}
if (exists $mail_info->{Mail_Method}) {
$mail_method=$mail_info->{Mail_Method};
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Method})) {
$mail_method=$email_defaults{Mail_Method};
}
if (exists $mail_info->{Mail_Server}) {
$mail_server=$mail_info->{Mail_Server};
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Server})) {
$mail_server=$email_defaults{Mail_Server};
}
if (exists $mail_info->{Mail_Port}) {
$mail_port=$mail_info->{Mail_Port};
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Port})) {
$mail_port=$email_defaults{Mail_Port};
}
if ($mail_method=~/smtp/i) {
if ($mail_server) {
if ($mail_port) {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server,
prot => $mail_port
});
} else {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server
});
}
}
}
$ent = MIME::Entity->build(Type => "multipart/mixed",
'X-Mailer' => undef);
if (exists $mail_info->{Bcc}) {
$ent->head->mime_attr(Bcc=>$mail_info->{Bcc});
$sendemail=1;
} elsif ($email_defaults &&
(exists $email_defaults{Bcc})) {
$ent->head->mime_attr(Bcc=>$email_defaults{Bcc});
$sendemail=1;
}
if (exists $mail_info->{Cc}) {
$ent->head->mime_attr(Cc=>$mail_info->{Cc});
$sendemail=1;
} elsif ($email_defaults &&
(exists $email_defaults{Cc})) {
$ent->head->mime_attr(Cc=>$email_defaults{Cc});
$sendemail=1;
}
if (exists $mail_info->{"Reply-To"}) {
$ent->head->mime_attr("Reply-To"=>$mail_info->{"Reply-To"});
} elsif ($email_defaults &&
(exists $email_defaults{"Reply-To"})) {
$ent->head->mime_attr("Reply-To"=>$email_defaults{"Reply-To"});
}
if (exists $mail_info->{Priority}) {
$ent->head->mime_attr("Importance:"=>1);
}
if (exists $mail_info->{From}) {
$ent->head->mime_attr(From=>$mail_info->{From});
} elsif ($email_defaults && ref $email_defaults eq 'HASH' &&
(exists $email_defaults{From})) {
$ent->head->mime_attr(From=>$email_defaults{From});
} else {
$ent->head->mime_attr(From=>
"$Net::FullAuto::FA_Core::progname".
"\@$Net::FullAuto::FA_Core::local_hostname");
}
if (exists $mail_info->{Subject}) {
$ent->head->mime_attr(Subject=>$mail_info->{Subject});
} elsif ($email_defaults &&
(exists $email_defaults{Subject})) {
$ent->head->mime_attr(Subject=>$email_defaults{Subject});
} elsif ($usage eq 'notify_on_error') {
if ($warn) {
$subject="WARNING! from $Net::FullAuto::FA_Core::local_hostname";
} else {
$subject="FATAL ERROR! from ".
$Net::FullAuto::FA_Core::local_hostname;
}
$ent->head->mime_attr(Subject=>$subject);
$ent->head->mime_attr("Importance:"=>1) unless $warn;
}
if (exists $mail_info->{To}) {
if ($email_defaults &&
(exists $email_defaults{To})) {
$to=[];
push @{$to}, @{$email_defaults{To}};
}
if (exists $mail_info->{To} && $mail_info->{To}) {
if (ref $mail_info->{To} eq 'ARRAY') {
if ($to) {
push @{$to}, @{$mail_info->{To}};
} else { $to=$mail_info->{To} }
} else {
if ($to) {
push @{$to}, $mail_info->{To};
} else { $to=$mail_info->{To} }
}
}
if (ref $to eq 'ARRAY') {
my $going_to='';
foreach my $item (@{$to}) {
if ($item=~/(__|\])USERNAME(\[|__)/i) {
$going_to.="$email_addresses{$username}\,"
if exists $email_addresses{$username};
next;
} $going_to.="$item\,";
} $to=substr($going_to,0,-1);
} elsif ($to=~/(__|\])USERNAME(\[|__)/i) {
$to=$email_addresses{$username}
if exists $email_addresses{$username};
}
$ent->head->mime_attr(To=>$to);
$sendemail=1;
} elsif ($email_defaults &&
(exists $email_defaults{To})) {
$to=$email_defaults{To};
if (ref $to eq 'ARRAY') {
my $going_to='';
foreach my $item (@{$to}) {
if ($item=~/(__|\])USERNAME(\[|__)/i) {
$going_to.="$email_addresses{
$Net::FullAuto::FA_Core::username}\,"
if exists $email_addresses{
$Net::FullAuto::FA_Core::username};
next;
} $going_to.="$item\,";
} $to=substr($going_to,0,-1);
} elsif ($to=~/(__|\])USERNAME(\[|__)/i) {
$to=$email_addresses{$username}
if exists $email_addresses{$username};
}
$ent->head->mime_attr(To=>$to);
$sendemail=1;
}
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";
}
} else {
die "ERROR: No attachment file specified";
}
unless (exists $attach->{Type}) {
if ($attach->{Path}=~/[.](\S+)$/) {
my $mt=$1;
if (exists $mimetypes{$mt}) {
$attach->{Type}=$mimetypes{$mt};
} else {
$attach->{Type}="text/plain";
}
} else {
$attach->{Type}="text/plain";
}
}
unless (exists $attach->{Encoding}) {
$attach->{Encoding}='base64';
}
$ent->attach(
Path => $attach->{Path},
Type => $attach->{Type},
Encoding => $attach->{Encoding},
);
}
if (-f $attach) {
my $type='';
if ($attach=~/[.](\S+)$/) {
my $mt=$1;
if (exists $mimetypes{$mt}) {
$type=$mimetypes{$mt};
} else {
$type="text/plain";
}
} else {
$type="text/plain";
}
$ent->attach(
Path => $attach,
Type => $type,
Encoding => 'base64',
);
} else {
die "Cannot locate attachment file: $attach";
}
}
}
}
} elsif ($email_defaults) {
$usage=$email_defaults{Usage}
if (exists $email_defaults{Usage});
if ($usage ne 'notify_on_error'
&& (caller(1))[3] eq 'FA_Core::handle_error') {
return 0;
}
$mail_server=$email_defaults{Mail_Server}
if exists $email_defaults{Mail_Server};
$mail_port =$email_defaults{Mail_Port}
if exists $email_defaults{Mail_Port};
$mail_method=$email_defaults{Mail_Method}
if exists $email_defaults{Mail_Method};
if ($mail_method=~/smtp/i) {
if ($mail_server) {
if ($mail_port) {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server,
port => $mail_port
});
} else {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server
});
}
}
}
$ent = MIME::Entity->build(Type => "multipart/mixed",
'X-Mailer' => undef);
if (exists $email_defaults{Bcc}) {
$ent->head->mime_attr(Bcc=>$email_defaults{Bcc});
$sendemail=1;
}
if (exists $email_defaults{Cc}) {
$ent->head->mime_attr(Cc=>$email_defaults{Cc});
$sendemail=1;
}
if (exists $email_defaults{From}) {
$ent->head->mime_attr(From=>$email_defaults{From});
}
if (exists $email_defaults{Subject}) {
$ent->head->mime_attr(Subject=>$email_defaults{Subject});
}
if (exists $email_defaults{To}) {
$ent->head->mime_attr(To=>$email_defaults{To});
$sendemail=1;
}
} else {
warn "EMAIL ERROR - no email information defined $!";
$done_warning=1;
}
if (!$sendemail && !$done_warning) {
warn "EMAIL ERROR - no recipients defined $!";
}
if ($sendemail) {
if (ref $mail_info eq 'HASH') {
if (exists $mail_info->{Body}) {
$body=$mail_info->{Body};
} elsif ($email_defaults &&
(exists $email_defaults{Body})) {
$body=$email_defaults{Body};
} elsif (exists $mail_info->{Msg}) {
$body=$mail_info->{Msg};
} elsif ($email_defaults &&
(exists $email_defaults{Msg})) {
$body=$email_defaults{Msg};
} elsif (exists $mail_info->{Message}) {
$body=$mail_info->{Message};
} elsif ($email_defaults &&
(exists $email_defaults{Message})) {
$body=$email_defaults{Message};
}
} elsif ($email_defaults &&
(exists $email_defaults{Body})) {
$body=$email_defaults{Body};
} elsif ($email_defaults &&
(exists $email_defaults{Msg})) {
$body=$email_defaults{Msg};
}
$body=join '',@{$body} if ref $body eq 'ARRAY';
$ent->attach(Data => $body);
my $stdout_capture='';my $stderr_capture='';
while (1) {
my $eval_error='';
($stdout_capture,$stderr_capture)=Capture::Tiny::capture {
eval {
if ($transport) {
sendmail($ent,{transport=>$transport});
} else {
sendmail($ent);
}
};
$eval_error=$@;
};
if ($eval_error || $stdout_capture) {
if ($eval_error=~/^\s*$/ && $stdout_capture) {
$eval_error=$stdout_capture;
} elsif ($stdout_capture) {
$eval_error="$stdout_capture\n\n$eval_error";
}
print $Net::FullAuto::FA_Core::LOG $eval_error
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$eval_error,'';
} else {
die $eval_error;
}
} elsif (wantarray) {
return 'Mail sent OK.','','';
} elsif ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet) {
print "\nMail sent OK.\n";
last;
}
}
}
}
$main::get_default_modules=sub {
if ($Net::FullAuto::cpu) {
my $idle=(split ',', $Net::FullAuto::cpu)[3];
$idle=~s/^\s*//;
$idle=~s/%.*$//;
my $cpyou=100-$idle;
if ($idle<20) {
my $die="FATAL ERROR - CPU Usage is too high\n"
." to run FullAuto safely.\n"
." CPU are Starttime ==> ${cpyou}%\n";
&handle_error($die);
}
}
my $username=&Net::FullAuto::FA_Core::username();
unless (-f $Hosts{"__Master_${$}__"}{'FA_Core'}.'fa_global.pm') {
my $fd=$Hosts{"__Master_${$}__"}{'FA_Core'}.'fa_global.pm';
open (FD,">$fd") or &handle_error("Cannot open $fd: $!\n");
print FD "package fa_global;";
my $affero=<<END;
### OPEN SOURCE LICENSE - GNU AFFERO PUBLIC LICENSE Version 3.0 #######
#
# Net::FullAuto - Powerful Network Process Automation Software
# Copyright © 2000-2015 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 \$berkeley_db_path = \"",$Hosts{"__Master_${$}__"}{'berkeley_db_path'},"\";\n",
"\n",
"#################################################################\n",
"## Do NOT alter code BELOW this block.\n",
"#################################################################\n",
"1;";
close(FD);
}
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Defaults');
my $default_modules='';
my $status=$bdb->db_get($username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';
$default_modules=eval $default_modules;
$default_modules||='';
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
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_menu}) {
my ($dbenv,$bdb)=Net::FullAuto::FA_Core::connect_berkeleydb('Sets');
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_menu => 'Net/FullAuto/Distro/fa_menu_demo.pm',
},
};
my $put_sref=
Data::Dump::Streamer::Dump($sref)->Out();
$status=$bdb->db_put($username,$put_sref);
$default_modules={
set => 'none',
fa_code => 'Net/FullAuto/Distro/fa_code_demo.pm',
fa_conf => 'Net/FullAuto/Distro/fa_conf.pm',
fa_host => 'Net/FullAuto/Distro/fa_host.pm',
fa_menu => 'Net/FullAuto/Distro/fa_menu_demo.pm',
};
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
return $default_modules;
};
my $set_default_sub=sub {
package set_default_sub;
my $default_set=shift;
no strict 'subs';
use BerkeleyDB;
use File::Path;
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);
my $progname=substr($0,(rindex $0,'/')+1,-3);
require "$loc/fa_global.pm";
my ($dbenv,$bdb)=Net::FullAuto::FA_Core::connect_berkeleydb('Sets');
my $mysets='';
my $status=$bdb->db_get($username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
my $desc='';
my @sets=();
foreach my $key (keys %{$mysets}) {
push @sets,"SET Label: $key\n ".
"Description: ".$mysets->{$key}{'Description'};
}
return [ sort @sets ];
};
my $get_modules=sub {
use File::Path;
use File::Copy;
my $type=$_[0]||'';
unless ($type) {
$type=']P[';
my $ind=rindex $type,'fa_';
$type=substr($type,$ind+3,$ind+7);
}
my $username=&Net::FullAuto::FA_Core::username();
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);
my $mkdflag=0;
unless (-d "$fadir/Custom/$username/$type") {
$mkdflag=1;
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
unless (-d "$fadir/Custom") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."\'$fadir/Custom\'";
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
}
unless (-d "$fadir/Custom/$username") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."\'$fadir/Custom/$username\'";
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
}
unless (-d "$fadir/Custom/$username/$type") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."\'$fadir/Custom/$username/$type\'";
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('cp').'cp '.
"\'$fadir/Custom/fa_".lc($type).'.pm\' '.
"\'$fadir/Custom/$username/$type\'";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
}
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
"\'$fadir/Custom/$username/$type\'";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr && -1==index $stderr,'mode of';
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('ls')."ls -1 ".
"\'$fadir/Custom/$username/$type\' 2>&1";
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');
$cmd="$cmd | ${sedpath}sed -e \'s/^/stdout: /\' 2>&1";
my @return=();
my ($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
foreach my $entry (split "\n",$stdout) {
next if $entry eq '.';
next if $entry eq '..';
next if -d $entry;
push @return, $entry;
}
return \@return;
};
my $custmm=<<'FIN';
__ __ __ __ _ _
| \/ |___ _ _ _ _ | \/ |___ __| |_ _| |___
| |\/| / -_) ' \ || | | |\/| / _ \/ _` | || | / -_)
|_| |_\___|_||_\_,_| |_| |_\___/\__,_|\_,_|_\___|
FIN
my $custpm=<<'FIN';
__ __ __ __ _ _
| \/ |__ _ _ __ ___ | \/ |___ __| |_ _| |___
| |\/| / _` | '_ (_-< | |\/| / _ \/ _` | || | / -_)
|_| |_\__,_| .__/__/ |_| |_\___/\__,_|\_,_|_\___|
|_|
FIN
my $custhm=<<'FIN';
_ _ _ __ __ _ _
| || |___ __| |_ | \/ |___ __| |_ _| |___
| __ / _ (_-< _| | |\/| / _ \/ _` | || | / -_)
|_||_\___/__/\__| |_| |_\___/\__,_|\_,_|_\___|
FIN
my $custfm=<<'FIN';
___ __ __ __ _ _
/ __|___ _ _ / _| | \/ |___ __| |_ _| |___
| (__/ _ \ ' \| _| | |\/| / _ \/ _` | || | / -_)
\___\___/_||_|_| |_| |_\___/\__,_|\_,_|_\___|
FIN
my $custcm=<<'FIN';
___ _ __ __ _ _
/ __|___ __| |___ | \/ |___ __| |_ _| |___
| (__/ _ \/ _` / -_) | |\/| / _ \/ _` | || | / -_)
\___\___/\__,_\___| |_| |_\___/\__,_|\_,_|_\___|
FIN
my $fabann=sub {
my $default_modules=$_[0] || $main::get_default_modules->();
my $type=$_[1]||'';
unless ($type) {
$type=']P[';
my $ind=rindex $type,'fa_';
$type=substr($type,$ind+3,$ind+7);
}
my $caps='';
if ($type eq 'code') {
$caps=$custcm;
} elsif ($type eq 'conf') {
$caps=$custfm;
} elsif ($type eq 'host') {
$caps=$custhm;
} else {
$caps=$custmm;
}
my $set='';
if ($default_modules->{'set'} ne 'none') {
$set=" WARNING!: Set \'$default_modules->{'set'}\'".
" is currently the Default Set;\n ".
"it will be changed to \'none\' if you proceed.\n".
" Run \'fa --set\' to work with ".
"FullAuto Sets.\n\n";
}
return " CURRENT MODULE DEFAULTS when Default Set".
" is \'none\':\n\n Code => ".
$default_modules->{'fa_code'}."\n".
" Conf => ".
$default_modules->{'fa_conf'}."\n".
" Host => ".
$default_modules->{'fa_host'}."\n".
" Maps => ".
$default_modules->{'fa_menu'}."\n\n".
"$caps$set Please select the fa_".$type."[.*].pm ".
"module that will become the new\n ".
ucfirst($type)." Module Default (run \'fa --import\'".
" to add more choices):";
};
my $fasetdef=sub {
package fasetdef;
use BerkeleyDB;
use File::Path;
no strict 'subs';
my $username=&Net::FullAuto::FA_Core::username();
my $progname=substr($0,(rindex $0,'/')+1,-3);
my ($dbenv,$bdb)=Net::FullAuto::FA_Core::connect_berkeleydb('Defaults');
my $default_modules='';
my $status=$bdb->db_get(
$username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';
$default_modules=eval $default_modules;
$default_modules||={};
$default_modules->{'set'}='none';
if (-1<index ']S[','code') {
$default_modules->{'fa_code'}=
"Net/FullAuto/Custom/$username/".
"Code/]S[";
unless (exists $default_modules->{'fa_conf'}) {
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
}
} elsif (-1<index ']S[','conf') {
$default_modules->{'fa_conf'}=
"Net/FullAuto/Custom/$username/".
"Conf/]S[";
unless (exists $default_modules->{'fa_host'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
}
} elsif (-1<index ']S[','host') {
$default_modules->{'fa_host'}=
"Net/FullAuto/Custom/$username/".
"Host/]S[";
unless (exists $default_modules->{'fa_menu'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
}
} else {
$default_modules->{'fa_menu'}=
"Net/FullAuto/Custom/$username/".
"Menu/]S[";
unless (exists $default_modules->{'fa_menu'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
}
}
my $put_dref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();
$status=$bdb->db_put(
$username,$put_dref);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n New Default Modules ".
"now:\n\n Code => ".
$default_modules->{'fa_code'}.
"\n Conf => ".
$default_modules->{'fa_conf'}.
"\n Host => ".
$default_modules->{'fa_host'}.
"\n Menu => ".
$default_modules->{'fa_menu'}.
"\n Set => \'none\'".
"\n\n";
return "Finished Default Module";
};
my $default_sets_banner_sub=sub {
package default_sets_banner;
no strict 'subs';
use BerkeleyDB;
use File::Path;
use Data::Dump::Streamer;
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);
my $progname=substr($0,(rindex $0,'/')+1,-3);
require "$loc/fa_global.pm";
my $mkdflag=0;
my $dfbann=<<'FIN';
___ _ _ _ _ ___ __ _ _
| __| _| | | /_\ _ _| |_ | | \ ___ / _|__ _ _ _| | |_ ___
| _| || | | |/ _ \ || | _/ | \ | |) / -_) _/ _` | || | | _(_-<
|_| \_,_|_|_/_/ \_\_,_|\__\___/© |___/\___|_| \__,_|\_,_|_|\__/__/
FIN
my ($dbenv,$bdb)=Net::FullAuto::FA_Core::connect_berkeleydb('Sets');
my $mysets='';
my $status=$bdb->db_get($username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
my $default_modules=$_[0] || $main::get_default_modules->();
my $set=$default_modules->{'set'};
my $spc=length $set;
$spc=pack("A$spc",'');
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 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";
return $banner;
};
my $fa_congrats=<<'END';
___ _ _ _ _ _
/ __|___ _ _ __ _ _ _ __ _| |_ _ _| |__ _| |_(_)___ _ _ __| |
| (__/ _ \ ' \/ _` | '_/ _` | _| || | / _` | _| / _ \ ' \(_-<_|
\___\___/_||_\__, |_| \__,_|\__|\_,_|_\__,_|\__|_\___/_||_/__(_)
|___/
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)",
},
Scroll => 2,
Banner => $fa_congrats,
);
return \%setup_new_user11;
};
my $cacomm_sub=sub {
my $new_user_flag=0;my $item_2={};
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 --defaults] will EXIT )",
},
}
my %cacomm=(
Name => 'cacomm',
Item_1 => {
Text => "YES",
Result => sub {
package del_sets;
$main::get_default_modules->()
unless defined $Net::FullAuto::FA_Core::fa_global;
#use BerkeleyDB;
use File::Path;
no strict 'subs';
my $username=&Net::FullAuto::FA_Core::username();
my $loc=substr($INC{'Net/FullAuto.pm'},
0,-3);
my $progname=substr($0,(rindex $0,'/')
+1,-3);
require "$loc/fa_global.pm";
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb(
'Defaults');
my $default_modules='';
my $status=$bdb->db_get(
$username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';
$default_modules=eval $default_modules;
$default_modules||={};
$default_modules->{'set'}='none';
$default_modules->{'fa_code'}=
"Net/FullAuto/Custom/$username/".
"Code/]P[{cacode}";
$default_modules->{'fa_conf'}=
"Net/FullAuto/Custom/$username/".
"Conf/]P[{caconf}";
$default_modules->{'fa_host'}=
"Net/FullAuto/Custom/$username/".
"Host/]P[{cahost}";
$default_modules->{'fa_menu'}=
"Net/FullAuto/Custom/$username/".
"Menu/]P[{camenu}";
my $put_dref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();
$status=$bdb->db_put(
$username,$put_dref);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n New Default Modules ".
"now:\n\n Code => ".
"Net/FullAuto/Custom/$username/Code/".
"]P[{cacode}\n Conf => ".
"Net/FullAuto/Custom/$username/Conf/".
"]P[{caconf}\n Host => ".
"Net/FullAuto/Custom/$username/Host/".
"]P[{cahost}\n Menu => ".
"Net/FullAuto/Custom/$username/Menu/".
"]P[{camenu}\n Set => ".
"\'none\'\n\n";
if (defined $main::new_user_flag &&
$main::new_user_flag) {
return $setup_new_user11;
}
return "Finished Defining Defaults";
}
},
Item_2 => $item_2,
Scroll => 1,
Banner => sub {
my $custnd=<<'FIN';
_ _ ___ __ _ _
| \| |_____ __ __ | \ ___ / _|__ _ _ _| | |_ ___
| .` / -_) V V / | |) / -_) _/ _` | || | | _(_-< o
|_|\_\___|\_/\_/ |___/\___|_| \__,_|\_,_|_|\__/__/ o
FIN
my $username=&Net::FullAuto::FA_Core::username();
return "$custnd Code => ".
"Net/FullAuto/Custom/$username/Code/".
"]P[{cacode}\n".
" Conf => Net/FullAuto/Custom/$username/Conf/".
"]P[{caconf}\n".
" Host => Net/FullAuto/Custom/$username/Host/".
"]P[{cahost}\n".
" Menu => Net/FullAuto/Custom/$username/Menu/".
"]P[{camenu}\n Set => none\n\n\n ".
"Would you like to COMMIT the New Defaults?:\n";
},
);
return \%cacomm;
};
my $camenu_sub=sub {
my %camenu=(
Name => 'camenu',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => $cacomm_sub->(),
},
Scroll => 1,
Banner => sub {
my $username=&Net::FullAuto::FA_Core::username();
return " Code => Net/FullAuto/Custom/$username/Code/".
"]P[{cacode}\n".
" Conf => Net/FullAuto/Custom/$username/Conf/".
"]P[{caconf}\n".
" Host => Net/FullAuto/Custom/$username/Host/".
"]P[{cahost}\n".
"$custmm Please select a fa_menu[.*].pm ".
"module:\n";
},
);
return \%camenu;
};
my $cahost_sub=sub {
my %cahost=(
Name => 'cahost',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => $camenu_sub->(),
},
Scroll => 1,
Banner => sub {
my $username=&Net::FullAuto::FA_Core::username();
return " Code => Net/FullAuto/Custom/$username/Code/".
"]P[{cacode}\n".
" Conf => Net/FullAuto/Custom/$username/Conf/".
"]P[{caconf}\n\n".
"$custhm Please select a fa_host[.*].pm ".
"module:\n";
},
);
return \%cahost;
};
my $caconf_sub=sub {
my %caconf=(
Name => 'caconf',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => $cahost_sub->(),
},
Scroll => 1,
Banner => sub {
my $username=&Net::FullAuto::FA_Core::username();
return " Code => Net/FullAuto/Custom/$username/Code/".
"]P[{cacode}\n\n".
"$custfm Please select a fa_conf[.*].pm ".
"module:\n";
},
);
return \%caconf;
};
my $cacode_sub=sub {
my %cacode=(
Name => 'cacode',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Code'),
Result => $caconf_sub->(),
},
Scroll => 1,
Banner => "$custcm Please select a fa_code[.*].pm ".
"module:\n\n",
);
return \%cacode;
};
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,
},
Scroll => 1,
Banner => $fabann,
);
return \%define_module_from_viewdef;
};
my $vdbanner=sub {
my $dfbann=<<'FIN';
___ _ _ _ _ ___ __ _ _
| __| _| | | /_\ _ _| |_ | | \ ___ / _|__ _ _ _| | |_ ___
| _| || | | |/ _ \ || | _/ | \ | |) / -_) _/ _` | || | | _(_-<
|_| \_,_|_|_/_/ \_\_,_|\__\___/© |___/\___|_| \__,_|\_,_|_|\__/__/
FIN
my $default_modules=$_[0] || $main::get_default_modules->();
my $banner=$dfbann;
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
$banner.=" ** NO DEFAULT SET DEFINED **\n\n";
}
$banner.=" Code => "
.$default_modules->{'fa_code'}
."\n Conf => "
.$default_modules->{'fa_conf'}
."\n Host => "
.$default_modules->{'fa_host'}
."\n Menu => "
.$default_modules->{'fa_menu'}
."\n\n";
return $banner;
};
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_menu'],
Result => $define_module_from_viewdef_sub->($_[0]),
},
Scroll => 1,
Banner => $vdbanner->($_[0]),
);
return \%viewdefaults;
};
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_menu'],
},
Banner => $default_sets_banner_sub->($_[0]),
);
return \%defaultsettings;
};
my $admin_defaults_sub=sub {
my $default_modules=$main::get_default_modules->();
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
return $viewdefaults_sub->($default_modules);
} else {
return $defaultsettings_sub->($default_modules);
}
};
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));
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults') ||
($selection eq 'Finished Default Module')) {
&cleanup();
}
} else {
my $selection=Menu($defaultsettings_sub->($default_modules));
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults')) {
&cleanup();
}
}
};
my $define_modules_commit_sub=sub {
my %define_modules_commit=(
Name => 'define_modules_commit',
Item_1 => {
Text => "YES",
Result => sub {
package set_default_sub;
no strict 'subs';
use BerkeleyDB;
use File::Path;
use Data::Dump::Streamer;
my $username=&Net::FullAuto::FA_Core::username();
my $progname=substr($0,(rindex $0,'/')+1,-3);
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb(
'Sets');
my $mysets='';
my $status=$bdb->db_get($username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
my $ph="Net/FullAuto/Custom/$username/";
$mysets->{$main::setname}={
Label => $main::setname,
Description => $main::desc,
fa_code =>
$ph."Code/]P[{define_modules_menu_fa_code}",
fa_conf =>
$ph."Conf/]P[{define_modules_menu_fa_conf}",
fa_host =>
$ph."Host/]P[{define_modules_menu_fa_host}",
fa_menu =>
$ph."Menu/]P[{define_modules_menu_fa_menu}"
};
my $put_mref=
Data::Dump::Streamer::Dump($mysets)->Out();
$status=$bdb->db_put($username,$put_mref);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return "Finished Defining Set";
},
},
Item_2 => {
Text => "No ( FullAuto [fa --set] will EXIT )",
},
Scroll => 2,
Banner => sub {
my $custns=<<'FIN';
_ _ ___ _
| \| |_____ __ __ / __| ___| |_
| .` / -_) V V / \__ \/ -_) _| o
|_|\_\___|\_/\_/ |___/\___|\__| o
FIN
my $spc=length $main::setname;
$spc=pack("A$spc",'');
return "$custns \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n".
" $spc Conf => ".
"]P[{define_modules_menu_fa_conf}\n".
" $spc Host => ".
"]P[{define_modules_menu_fa_host}\n".
" $spc 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 )?:";
},
);
return \%define_modules_commit;
};
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;
$spc=pack("A$spc",'');
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n".
" $spc Conf => ".
"]P[{define_modules_menu_fa_conf}\n".
" $spc Host => ".
"]P[{define_modules_menu_fa_host}\n".
"$custmm Please select a fa_menu[.*].pm ".
"module:\n";
},
);
return \%define_modules_menu_fa_menu;
};
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_menu_sub->(),
},
Banner => sub {
my $spc=length $main::setname;
$spc=pack("A$spc",'');
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n".
" $spc Conf => ".
"]P[{define_modules_menu_fa_conf}\n\n".
"$custhm Please select a fa_host[.*].pm ".
"module:\n";
},
);
return \%define_modules_menu_fa_host;
};
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->(),
},
Scroll => 1,
Banner => sub {
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n\n".
"$custfm Please select a fa_conf[.*].pm ".
"module:\n";
},
);
return \%define_modules_menu_fa_conf;
};
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;
use File::Copy;
while (1) {
print "\n\n\n Please type the name\n".
" for the new Set: ";
$main::setname=<STDIN>;
chomp($main::setname);
my $sets=$set_default_sub->();
my %sets=();
foreach my $set (@{$sets}) {
$set=~s/^.*Label:\s+(.*?)\s+.*$/$1/s;
$sets{$set}='';
}
if (exists $sets{$main::setname}) {
my $bann=" The set name you typed: ".
"$main::setname\n already ".
"is in use. Would\n you ".
"like to replace it?";
my $ans=Term::Menus::pick(['yes','no'],$bann);
if ($ans eq 'no') {
next;
} else { last }
} elsif ($main::setname=~/^\s*$/) {
next;
} else { last }
}
print "\n\n\n Please type the Description\n".
" for the new Set: ";
$main::desc=<STDIN>;
chomp($main::desc);
my $username=&Net::FullAuto::FA_Core::username();
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);
unless (-d "$fadir/Custom/$username/Code") {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
unless (-d "$fadir/Custom") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."$fadir/Custom";
my $stdout='';my $stderr='';
($stdout,$stderr)=
&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
die $stderr if $stderr;
}
unless (-d "$fadir/Custom/$username") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."$fadir/Custom/$username";
my $stdout='';my $stderr='';
($stdout,$stderr)=
&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
die $stderr if $stderr;
}
unless (-d "$fadir/Custom/$username/Code") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."$fadir/Custom/$username/Code";
my $stdout='';my $stderr='';
($stdout,$stderr)=
&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
die $stderr if $stderr;
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('cp').'cp '.
"$fadir/Custom/fa_code.pm ".
"$fadir/Custom/$username/Code";
my ($stdout,$stderr)=
&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
die $stderr if $stderr;
if ($^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod').
"chmod -Rv $mode ".
"$fadir/Custom/$username/Code/*";
my ($stdout,$stderr)=
&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
die $stderr if $stderr && -1==index $stderr,'mode of';
}
}
opendir(DIR,"$fadir/Custom/$username/Code");
my @xfiles = readdir(DIR);
my @return=();
closedir(DIR);
foreach my $entry (@xfiles) {
next if $entry eq '.';
next if $entry eq '..';
next if -d $entry;
push @return, $entry;
}
return @return;
},
Result => $define_modules_menu_fa_conf_sub->(),
},
Scroll => 1,
Banner => sub {
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";
},
);
return \%define_modules_menu_fa_code;
};
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->();
my @ret=();
foreach my $ar (@{$arr}) {
push @ret,"$ar\n\n";
}
return @ret;
},
Result => sub {
package del_sets;
use BerkeleyDB;
use File::Path;
use Cwd;
no strict 'subs';
my $res='';
if ("]S[") {
$res="]S[";
if (substr($res,0,1) eq '[') {
$res=eval $res;
}
}
my $username=&Net::FullAuto::FA_Core::username();
my $progname=substr($0,(rindex $0,'/')
+1,-3);
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb(
'Defaults');
my $default_modules='';
my $status=$bdb->db_get(
$username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,
'$HASH';
$default_modules=eval $default_modules;
$default_modules||='';
my ($sdbenv,$sbdb)=
Net::FullAuto::FA_Core::connect_berkeleydb(
'Sets');
my $mysets='';
$status=$sbdb->db_get(
$username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
foreach my $set (@{$res}) {
$set=~
s/^.*Label:\s+(.*?)\s+.*$/$1/s;
if ($default_modules->{'set'}
eq $set) {
my $ban=
"\n\n WARNING!: You are ".
"about to delete the default".
" set\n\n -> \'$set\'; ".
" Do you still wish to ".
"proceed?\n\n (The ".
"Default Set will be set to".
" \'none\' if \'yes\')";
my $ans=Term::Menus::pick(
['yes','no'],$ban);
if ($ans eq 'no') {
next;
} else {
$default_modules->{'set'}=
'none';
}
}
delete $mysets->{$set};
}
my $put_dref=
Data::Dump::Streamer::Dump(
$mysets)->Out();
$status=
$sbdb->db_put($username,$put_dref);
my $put_fref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();
$status=
$bdb->db_put($username,$put_fref);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
$sbdb->db_close();
undef $sbdb;
$sdbenv->close();
undef $sdbenv;
return 'Finished Deleting Set';
},
},
Select => 'Many',
Banner => sub {
my $custds=<<'FIN';
___ _ _ ___ _
| \ ___| |___| |_ ___ / __| ___| |_ ___
| |) / -_) / -_) _/ -_) \__ \/ -_) _(_-<
|___/\___|_\___|\__\___| |___/\___|\__/__/
FIN
return "$custds ".
"Please Select one or more Sets to Delete:"
},
);
return \%delete_sets_menu;
};
my $manage_modules_menu_sub=sub {
my $default_modules=$_[0] || $main::get_default_modules->();
$default_modules->{'set'}||='none';
my $current_default_set=$default_modules->{'set'};
my $mm_banner=" Please Select a Module Set Operation:\n\n";
if ($current_default_set eq 'none') {
$mm_banner.=" ** NO DEFAULT SET DEFINED **\n";
} else {
$mm_banner.=
" ** DEFAULT SET -> $current_default_set **\n";
}
my %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
);
return \%manage_modules_menu;
};
my $set_default_menu_in_db_sub=sub {
package set_default_menu_in_db_sub;
no strict 'subs';
use BerkeleyDB;
use File::Path;
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);
my $progname=substr($0,(rindex $0,'/')+1,-3);
require "$loc/fa_global.pm";
my $selection=']S[';
$selection=~s/^.*Label:\s+(.*?)\s+.*$/$1/s;
$selection='none' if -1<index $selection,"'none'";
my $default_modules=$main::get_default_modules->();
$default_modules->{'set'}=$selection;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Defaults');
my $put_dref=
Data::Dump::Streamer::Dump($default_modules)->Out();
my $status=$bdb->db_put($username,$put_dref);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n Default Module Set is now -> \'$selection\'.\n";
&Net::FullAuto::FA_Core::cleanup();
};
my $set_default_menu_sub=sub {
my $default_modules=$_[0] || $main::get_default_modules->();
$default_modules->{'set'}||='none';
my $current_default_set=$default_modules->{'set'};
my $sdf_banner=" Please Select a Default Module Set:\n\n";
my $clearoption='';
my $username=&Net::FullAuto::FA_Core::username();
if ($current_default_set eq 'none') {
$sdf_banner.=" ** NO DEFAULT SET DEFINED **\n";
$clearoption="Keep as 'none'\n\n";
} else {
$sdf_banner.=
" ** DEFAULT SET -> $current_default_set **\n";
$clearoption="Set to 'none'\n\n";
}
my %set_default_menu=(
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
);
return \%set_default_menu;
};
my $insert_comp_sub=sub {
my $item_to_insert_around="]T[{select_how_to_insert}";
$item_to_insert_around=~s/^["](.*)["]$/$1/;
my $comp_dir="]!P[{select_component_dir}";
$comp_dir=~s/^["](.*)["]$/$1/;
my $comp_to_import="]!P[{select_comp_to_import}";
$comp_to_import=~s/^["](.*)["]$/$1/;
$comp_to_import=~s/\s+at Line.*$//;
my $local_code=&Net::FullAuto::FA_Core::fa_set;
require PPI;
my %fa_subs=();
foreach my $sub (keys %main::fa_subs) {
$fa_subs{$main::fa_subs{$sub}->[0]}=$main::fa_subs{$sub}->[1];
}
my %loc_subs=();
my $local_doc = PPI::Document->new($local_code->{lc($comp_dir)});
my $subs_ref =
$local_doc->find(
sub { $_[1]->isa('PPI::Statement::Sub') });
my %refs=();
foreach my $ref (@$subs_ref) {
unless ($ref->forward) {
$loc_subs{ $ref->location->[0] } =
[ $ref->name, $ref->content ];
$refs{$ref->name}=$ref;
}
}
my $replace_flag=0;
my $where='above';
if ($item_to_insert_around=~s/^Replace\s+(.*)$/$1/) {
$replace_flag=1;
} else {
$item_to_insert_around=~s/^Insert (above|below)\s+(.*?)\s+at Line.*$/$2/;
$where=$1;
}
if ($where eq 'above') {
my $lines=PPI::Document->new(\"\n\n");
my $import_sub=PPI::Document->new(\$fa_subs{$comp_to_import});
$refs{$item_to_insert_around}->__insert_before($import_sub);
$refs{$item_to_insert_around}->__insert_before($lines);
if ($replace_flag) {
while (my $ws=$refs{$item_to_insert_around}->next_token) {
last if $ws ne "\n";
$ws->remove;
}
$refs{$item_to_insert_around}->remove if $replace_flag;
}
} else {
my $import_sub=PPI::Document->new(\$fa_subs{$comp_to_import});
$refs{$item_to_insert_around}->__insert_after($import_sub);
my $lines=PPI::Document->new(\"\n\n");
$refs{$item_to_insert_around}->__insert_after($lines);
}
$local_doc->save($local_code->{lc($comp_dir)});
return '{admin}<'
};
my $select_location_to_insert_comp_sub=sub {
my $insert_item="]T[{select_comp_to_import}";
$insert_item=~s/^["](.*)["]$/$1/;
my $i_item=$insert_item;
$i_item=~s/\s*at Line.*//;
my $compon="]!P[{select_component_dir}";
$compon=~s/^["](.*)["]$/$1/;
my $local_code=&Net::FullAuto::FA_Core::fa_set;
require PPI;
require Data::Dump::Streamer;
my %loc_subs=();
my $local_doc = PPI::Document->new($local_code->{lc($compon)});
my $subs_ref =
$local_doc->find(
sub { $_[1]->isa('PPI::Statement::Sub') });
my $replace_flag=0;
foreach my $ref (@$subs_ref) {
unless ($ref->forward) {
if ($ref->name eq $i_item) {
$replace_flag=1;
}
$loc_subs{ $ref->location->[0] } =
[ $ref->name, $ref->content ];
}
}
my @comp=();
my $ll=0;my $l=0;
foreach my $loc (keys %main::loc_subs) {
$l=length $loc_subs{$loc}->[0];
$ll=$l if $l>$ll;
}
$ll+=3;
foreach my $loc (sort numerically keys %loc_subs) {
push @comp, "Insert above ".sprintf "%-${ll}s %-s",
$loc_subs{$loc}->[0]," at Line $loc";
}
my $last=$comp[$#comp];
$last=~s/ above / below /;
push @comp, $last;
if ($replace_flag) {
unshift @comp, "Replace $i_item";
}
my $banner='';
if ($compon eq 'Code') {
$banner=" Select how to insert CCB - $i_item";
} elsif ($compon eq 'Host') {
$banner=" Select how to insert CHB - $i_item";
} elsif ($compon eq 'Conf') {
$banner=" Select how to insert CCI - $i_item";
} elsif ($compon eq 'Maps') {
$banner=" Select how to insert CMI - $i_item";
} else {
$banner=" Select how to insert CMB - $i_item";
}
my %select_how_to_insert=(
Name => 'select_how_to_insert',
Item_1 => {
Text => ']C[',
Convey => \@comp,
Result => $insert_comp_sub,
},
Banner => $banner,
);
return \%select_how_to_insert,
};
my $select_file_components_to_import_sub=sub {
my $file_comp="]T[{select_user_comp_file}";
my $user="]!P[{remote_fa_users}";
$user=~s/^["](.*)["]$/$1/;
my $compon="]!P[{select_component_dir}";
$compon=~s/^["](.*)["]$/$1/;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=$main::remote_host->cmd(
'/usr/local/bin/fullauto --cat '.
$file_comp);
if ($stderr) {
$main::remote_host->close();
$stderr=~s/Connection cl/ Connection cl/s;
$stderr=~s/^\s*//s;
print $Net::FullAuto::FA_Core::blanklines,"\n\n ",$stderr,
" Press ANY KEY to return to the Admin Menu\n";
alarm 120;
Term::ReadKey::ReadMode('cbreak');
# Turn off controls keys
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';
$key = ReadKey(0);
};
alarm(0);
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');
return '{admin}<';
} else {
require PPI;
require Data::Dump::Streamer;
%main::fa_subs=();
my $remote_doc = PPI::Document->new(\$stdout);
my $subs_ref =
$remote_doc->find( sub { $_[1]->isa('PPI::Statement::Sub') });
foreach my $ref (@$subs_ref) {
unless ($ref->forward) {
$main::fa_subs{ $ref->location->[0] } =
[ $ref->name, $ref->content ];
}
}
my $banner='';
if ($compon eq 'Code') {
$banner=" Select CCB (Custom Code Block) to Import";
} elsif ($compon eq 'Host') {
$banner=" Select CHB (Custom Host Block) to Import";
} elsif ($compon eq 'Conf') {
$banner=" Select CCI (Custom Config Item) to Import";
} elsif ($compon eq 'Maps') {
$banner=" Select CMI (Custom Maps Item) to Import";
} else {
$banner=" Select CMB (Custom Menu Block) to Import";
}
my @comp=();
my $ll=0;my $l=0;
foreach my $loc (keys %main::fa_subs) {
$l=length $main::fa_subs{$loc}->[0];
$ll=$l if $l>$ll;
}
$ll+=3;
foreach my $loc (sort numerically keys %main::fa_subs) {
push @comp, sprintf "%-${ll}s %-s",
$main::fa_subs{$loc}->[0]," at Line $loc";
}
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,
);
return \%select_comp_to_import,
}
};
my $select_component_file_sub=sub {
package select_component_file_sub;
use Term::ReadKey;
my $component="]!S[{select_component_dir}";
$component=~s/^["](.*)["]$/$1/;
my $server="]!P[{im_from_remote}";
$server=~s/^["]Import from (.*)["]$/$1/;
my $user="]!S[{remote_fa_users}";
$user=~s/^["](.*)["]$/$1/;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=$main::remote_host->cmd('/usr/local/bin/fullauto -V');
if ($stderr) {
$main::remote_host->close();
$stderr=~s/Connection cl/ Connection cl/s;
$stderr=~s/^\s*//s;
print $Net::FullAuto::FA_Core::blanklines,"\n\n ",$stderr,
" Press ANY KEY to return to the Admin Menu\n";
alarm 120;
Term::ReadKey::ReadMode('cbreak');
# Turn off controls keys
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';
$key = ReadKey(0);
};
alarm(0);
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');
return '{admin}<';
}
my @comp=();
foreach my $line (split "\n", $stdout) {
next if -1==index $line, "$user/$component";
push @comp, $line;
}
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",
);
return \%select_user_comp_file,
};
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',
);
return \%select_component_dir,
};
my $login_to_remote=sub {
package login_to_remote;
use Term::ReadKey;
my $host_to_connect_to=']T[{im_from_remote}';
$host_to_connect_to=~s/^"Import from (.*)"$/$1/;
use if (!defined $Net::FullAuto::FA_Core::localhost), 'Net::FullAuto';
our $fa_code='Net::FullAuto::FA_Core.pm';
my @Hosts=();my $fa_host='';
unless (-1<index $Net::FullAuto::FA_Core::localhost,'=') {
$main::plan_menu_sub=1;
eval {
&Net::FullAuto::FA_Core::fa_login();
undef $main::plan_menu_sub;
&Net::FullAuto::FA_Core::fa_set;
@Hosts=@{&Net::FullAuto::FA_Core::check_Hosts(
$Net::FullAuto::FA_Core::fa_host->[0])};
&Net::FullAuto::FA_Core::host_hash(\@Hosts);
};
die $@ if $@;
}
my $error='';
my $host='';
foreach my $h (@Hosts) {
#print "H=",$h->{Label}," and HOST_TO_CONN=$host_to_connect_to\n";
if ($h->{Label} eq $host_to_connect_to) {
$host=$h;
last;
}
}
($main::remote_host,$error)=
&Net::FullAuto::FA_Core::connect_ssh($host_to_connect_to);
if ($error) {
$main::remote_host->close();
$error=~s/Connection cl/ Connection cl/s;
$error=~s/^\s*//s;
print $Net::FullAuto::FA_Core::blanklines,"\n\n ",$error,
" Press ANY KEY to return to the Admin Menu\n";
alarm 120;
Term::ReadKey::ReadMode('cbreak');
# Turn off controls keys
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';
$key = ReadKey(0);
};
alarm(0);
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');
return '{admin}<';
}
my ($stdout,$stderr)=('','');
($stdout,$stderr)=$main::remote_host->cmd(
'/usr/local/bin/fullauto --users --quiet');
$stdout=~s/\s*$//s;
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";
#$main::remote_host->close();
print $Net::FullAuto::FA_Core::blanklines,$message;
alarm 120;
Term::ReadKey::ReadMode('cbreak');
# Turn off controls keys
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
my $key='';
$key = ReadKey(0);
};
alarm(0);
# Reset tty mode before exiting
Term::ReadKey::ReadMode('normal');
return '{admin}<';
}
print "USERS=$stdout<== and STDERR=$stderr\n";
my @users=();
foreach my $user (split /\n/,$stdout) {
chomp $user;
push @users, $user;
}
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',
);
return \%remote_fa_users;
}
&Net::FullAuto::FA_Core::cleanup;
};
my $im_from_remote=sub {
&Net::FullAuto::FA_Core::fa_set;
my $fa_host='';
my @Hosts=@{&Net::FullAuto::FA_Core::check_Hosts(
$Net::FullAuto::FA_Core::fa_host->[0])};
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',
);
return \%im_from_remote;
};
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',
);
return \%im_ex_menu;
};
my $set_menu_sub=sub {
my $default_modules=$_[0] || $main::get_default_modules->();
$default_modules->{'set'}||='none';
my $current_default_set=$default_modules->{'set'};
my $clearoption='';
my $sm_banner=<<FIN;
___ _ _ _ _ ___ _
| __| _| | | /_\ _ _| |_ | / __| ___| |_ ___
| _| || | | |/ _ \ || | _/ | \ \__ \/ -_) _(_-<
|_| \_,_|_|_/_/ \_\_,_|\__\___/© |___/\___|\__/__/
FIN
$sm_banner.=" Please Select a Module Set Operation:\n\n";
if ($current_default_set eq 'none') {
$sm_banner.=" ** NO DEFAULT SET DEFINED **\n";
$clearoption="Keep as 'none'\n\n";
} else {
$sm_banner.=
" ** DEFAULT SET -> $current_default_set **\n";
$clearoption="Set to 'none'\n\n";
}
my %set_menu=(
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
);
return \%set_menu;
};
our $fa_welcome=<<'END';
__ __)
(, ) | / /)
| /| / _ // _ ______ _ _/_ ___
|/ |/ _(/_(/_(__(_) // (__(/_ (__(_)
/ |
_ _ _ _____ _ _ _ _
| \ | | ___| |_ | ___| _| | | / \ _ _| |_ |
| \| |/ _ \ __| o o | |_ | | | | | | / _ \| | | | __/ | \
| |\ | __/ |_ o o | _|| |_| | | |/ ___ \ |_| | || |
|_| \_|\___|\__| |_| \__,_|_|_/_/ \_\__,_|\__\___/ ©
Copyright © 2000-2015 Brian M. Kelly Brian.Kelly@FullAuto.com
END
my $fa_tutorial=<<'END';
___ _ _ _ _
| __| _| | | /_\ _ _| |_ |
| _| || | | |/ _ \ || | _/ | \
|_| \_,_|_|_/_/ \_\_,_|\__\___/©
_____ _ _ _
|_ _| _| |_ ___ _ _(_)__ _| |
| || || | _/ _ \ '_| / _` | |
|_| \_,_|\__\___/_| |_\__,_|_|
END
my $fa_fullauto_welcome=<<END;
___ _ _ _ _
| __| _| | | /_\\ _ _| |_ |
( /_ /_ _ _ | _| || | | |/ _ \\ || | _/ | \\
|/|/(-(( ()//)(- To |_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/© $username
Items with the arrow character > are the current selection, Just
press ENTER or Scroll with UP and DOWN arrow keys. You can also type
the number of your selection, and then press ENTER to activate your
selection.
END
my $fa_fullauto=<<'END';
___ _ _ _ _
| __| _| | | /_\ _ _| |_ |
| _| || | | |/ _ \ || | _/ | \
|_| \_,_|_|_/_/ \_\_,_|\__\___/©
END
my $fa_mini_welcome=" ( /_ /_ _ _ \n".
" |/|/(-(( ()//)(- ";
my $fa_new_user=<<'END';
_ _ _ _
| \| |_____ __ __ | | | |___ ___ _ _
| .` / -_) V V / | |_| (_-</ -_) '_|
|_|\_\___|\_/\_/ \___//__/\___|_|
END
my $fa_process_lifecycle=<<'END';
___ _ _ __ _
| _ \_ _ ___ __ ___ ______ | | (_)/ _|___ __ _ _ __| |___
| _/ '_/ _ \/ _/ -_|_-<_-< | |__| | _/ -_) _| || / _| / -_)
|_| |_| \___/\__\___/__/__/ |____|_|_| \___\__|\_, \__|_\___|
|__/
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';
___ _ _ _
/ _ \ _ _ __ _ __ _ _ _ (_)_____ _| |_(_)___ _ _
| (_) | '_/ _` / _` | ' \| |_ / _` | _| / _ \ ' \
\___/|_| \__, \__,_|_||_|_/__\__,_|\__|_\___/_||_|
|___/
"A place for everything, everything in its place." - Benjamin Franklin
FullAuto organizes everything for you. A FullAuto working configuration
consists of four 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';
___ _
| _ \_ _(_)_ ____ _ __ _ _
| _/ '_| \ 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';
___ _ _
/ __| ___ __ _ _ _ _(_) |_ _ _
\__ \/ -_) _| || | '_| | _| || |
|___/\___\__|\_,_|_| |_|\__|\_, |
|__/
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';
___ ___ _
/ __| ___ _ __ ___ | _ ) __ _ __(_)__ ___
\__ \/ _ \ ' \/ -_) | _ \/ _` (_-< / _(_-<
|___/\___/_|_|_\___| |___/\__,_/__/_\__/__/
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 some hot key hints:
[F1] (F1 key on your keyboard) to get the help pages.
[ESC] to quit FullAuto.
You can also type out the words 'quit' or 'bye' or 'exit' to quit.
There are also hotkey shortcuts - 'admin' takes you to the admin menu.
When you quit either help or admin, you automatically return to this
screen. To quit admin, press [ESC], and help pages. type 'q'.
END
my $fa_no_web=<<'END';
_ _ __ __ _ ___ ___ _
| \| |___ \ \ / /__| |__ | _ \__ _ __ _ __|__ \ |
| .` / _ \ \ \/\/ / -_) '_ \ | _/ _` / _` / -_)/_/_|
|_|\_\___/ \_/\_/\___|_.__/ |_| \__,_\__, \___(_)(_)
|___/
YES! FullAuto is Automation & High Productivity software. Ever see a
furnace room with marble tile? Or a gold plated broom handle? We
decorate what we SEE and spend lots of *leisure* time around. Things
we rarely access, and places where we need sharp focus and a lack of
distraction, we keep simple and utilitarian. Ever seen an operating
room with a rich color palette? (No? - neither have I!)
__ _____ __ __ __ __ _____
(_ |_ | _|_ |_ / \|__)/ _ |_ |
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';
___ _ _ _ _
|_ _|_ _| |_ _ _ ___ __| |_ _ __| |_(_)___ _ _
| || ' \ _| '_/ _ \/ _` | || / _| _| / _ \ ' \
|___|_||_\__|_| \___/\__,_|\_,_\__|\__|_\___/_||_|
FullAuto is an Automation & High Productivity Framework. With FullAuto
almost any computer process can be *fully* automated. In addition,
processes can be optimized for extremely rapid and precise user interaction.
FullAuto was designed from the ground up to tackle both the problem of
process automation itself, and the often BIGGER problem of process
automation setup and maintenance. FullAuto is both the "end" and the
"means to the end". This is what makes FullAuto unique and groundbreaking.
This wizard is an important component of FullAuto. Everything you are
experiencing now is the High Productivity Framework in action. This
framework can be used to make your computer processes (such as complex
business and data manipulation processes and projects) easier to create,
manipulate and maintain. FullAuto makes +BIG DATA+ a lot -smaller-!
See this introduction anytime with this command: fa --new-user
END
my $fa_continue_setup=<<END;
END
my $fa_fa_code_banner=<<'END';
__ _
_/ _)__ _ __ ___ __| |___ _ __ _ __
( _/ _` | / _/ _ \/ _` / -_)_| '_ \ ' \
|_| \__,_|====\__\___/\__,_\___(_) .__/_|_|_|
|_|
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';
__ __
_/ _)__ _ __ ___ _ _ _/ _) _ __ _ __
( _/ _` | / _/ _ \ ' \( _/_| '_ \ ' \
|_| \__,_|====\__\___/_||_||_| (_) .__/_|_|_|
|_|
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';
__ _ _
_/ _)__ _ | |_ ___ __| |_ _ __ _ __
( _/ _` | | ' \/ _ (_-< _|_| '_ \ ' \
|_| \__,_|====|_||_\___/__/\__(_) .__/_|_|_|
|_|
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_menu_banner=<<'END';
__
_/ _|__ _ _ __ ___ _ _ _ _ _ __ _ __
( _/ _` | | ' \/ -_) ' \ || |_| '_ \ ' \
|_| \__,_|====|_|_|_\___|_||_\_,_(_) .__/_|_|_|
|_|
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';
___ _ _ _ _ ___ _
| _ ) __ _| |_| |_ ___ _ _ | | | | _ \ |
| _ \/ _` | _| _/ -_) '_| | |_| | _/_|
|___/\__,_|\__|\__\___|_| \___/|_| (_)
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 FullAuto "set" can
be active at any one time. A FullAuto "set" consists of
the the four 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 four files.
How does FullAuto know which four to use?
END
my $fa_fa_defaults2=<<'END';
___ _ ___ __ _ _
/ __| _ _ _ _ _ ___ _ _| |_ | \ ___ / _|__ _ _ _| | |_ ___
| (_| || | '_| '_/ -_) ' \ _| | |) / -_) _/ _` | || | | _(_-<
\___\_,_|_| |_| \___|_||_\__| |___/\___|_| \__,_|\_,_|_|\__/__/
The --defaults utility also (conveniently) displays what your current
END
my $fa_set_defaults=<<'END';
___ _ _ ___ _ _
/ __| |_ __ _ _ _| |_ | \ ___(_)_ _ __ _| |
\__ \ _/ _` | '_| _| | |) / _ \ | ' \/ _` |_|
|___/\__\__,_|_| \__| |___/\___/_|_||_\__, (_)
|___/
It's time to do you FIRST FullAuto activity! It's time to
select your very first "set" of the four 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. ';
my $username=&Net::FullAuto::FA_Core::username();
my $default_modules=$main::get_default_modules->();
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 four ".
"file locations below.\n\n\n";
} else {
$fa_fa_defaults2.="You can see\n".
" the full paths to these files anytime by using the ".
"command: fa -V\n\n\n";
}
my $banner=$fa_fa_defaults2;
$banner.=" Code => "
.$default_modules->{'fa_code'}
."\n Conf => "
.$default_modules->{'fa_conf'}
."\n Host => "
.$default_modules->{'fa_host'}
."\n Menu => "
.$default_modules->{'fa_menu'}
."\n\n";
return $banner;
};
my $fa_fa_defaults=<<'END';
___ _ _ _ _ ___ __ _ _
| __| _| | | /_\ _ _| |_ | | \ ___ / _|__ _ _ _| | |_ ___
| _| || | | |/ _ \ || | _/ | \ | |) / -_) _/ _` | || | | _(_-<
|_| \_,_|_|_/_/ \_\_,_|\__\___/© |___/\___|_| \__,_|\_,_|_|\__/__/
Most of the time you'll be working with the same four 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 four
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
experiencing.
You can access the --defaults utility at the command line: fa --defaults
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,
);
return \%fa_fa_code;
};
my $fa_fa_conf=sub {
my %fa_fa_conf=(
Name => 'fa_fa_conf',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_conf_banner,
);
return \%fa_fa_conf;
};
my $fa_fa_host=sub {
my %fa_fa_host=(
Name => 'fa_fa_host',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_host_banner,
);
return \%fa_fa_host;
};
my $fa_fa_menu=sub {
my %fa_fa_menu=(
Name => 'fa_fa_menu',
Result => sub { return '{setup_new_user5}<' },
Banner => $fa_fa_menu_banner,
);
return \%fa_fa_menu;
};
my $setup_new_user10=sub{
$main::new_user_flag=1;
my %setup_new_user10=(
Name => 'setup_new_user10',
Result => $viewdefaults_sub,
Banner => $fa_set_defaults,
);
return \%setup_new_user10;
};
my $setup_new_user9=sub{
$main::new_user_flag=1;
my %setup_new_user9=(
Name => 'setup_new_user9',
Result => $viewdefaults_sub,
Banner => $fa_fa_defaults_sub,
);
return \%setup_new_user9;
};
my $setup_new_user8=sub{
my %setup_new_user8=(
Name => 'setup_new_user8',
Result => $setup_new_user9,
Banner => $fa_fa_defaults,
);
return \%setup_new_user8;
};
my $setup_new_user7=sub{
my %setup_new_user7=(
Name => 'setup_new_user7',
Result => $setup_new_user8,
Banner => $fa_batter_up,
);
return \%setup_new_user7;
};
my $setup_new_user6=sub{
my %setup_new_user6=(
Name => 'setup_new_user6',
Result => $setup_new_user7,
Banner => $fa_process_lifecycle,
);
return \%setup_new_user6;
};
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_menu.pm',
Result => $fa_fa_menu,
},
Item_5 => {
Text => 'Continue Getting Started with FullAuto.',
Result => $setup_new_user6,
},
Scroll => 5,
Banner => $fa_organization,
);
return \%setup_new_user5;
};
my $setup_new_user4=sub{
my %setup_new_user4=(
Name => 'setup_new_user4',
Result => $setup_new_user5,
Banner => $fa_privacy,
);
return \%setup_new_user4;
};
my $setup_new_user3=sub{
my %setup_new_user3=(
Name => 'setup_new_user3',
Result => $setup_new_user4,
Banner => $fa_security,
);
return \%setup_new_user3;
};
my $setup_new_user2=sub {
my %setup_new_user2=(
Name => 'setup_new_user2',
#Result => $setup_new_user3,
Result => $setup_new_user5,
Banner => $fa_basics,
);
return \%setup_new_user2;
};
my $setup_new_user_a=sub {
my %setup_new_user_a=(
Name => 'setup_new_user_a',
Result => $setup_new_user2,
Banner => $fa_intro,
);
return \%setup_new_user_a;
};
my $setup_new_user=sub {
my %setup_new_user=(
Name => 'setup_new_user',
Result => $setup_new_user_a,
Banner => $fa_no_web,
);
return \%setup_new_user;
};
my $do_wxPerl_setup=sub {
package do_wxPerl_setup;
require Net::FullAuto::FA_Core;
import FA_Core;
# http://joekiller.com/2012/06/03/ \
# install-firefox-on-amazon-linux-x86_64-compiling-gtk/
# https://forums.aws.amazon.com/thread.jspa?messageID=224857
# http://raspberrypi.stackexchange.com/questions/1719/ \
# x11-connection-rejected-because-of-wrong-authentication
# https://wiki.archlinux.org/index.php/Running_X_apps_as_root
print "\n";
my $c='sudo yum --assumeyes install make libjpeg-devel libpng-devel '.
'libtiff-devel gcc libffi-devel gettext-devel libmpc-devel '.
'libstdc++46-devel xauth gcc-c++ libtool libX11-devel '.
'libXext-devel libXinerama-devel libXi-devel libxml2-devel '.
'libXrender-devel libXrandr-devel libXt dbus-glib '.
'pandgo pango-devel';
open(AWS,"$c|");
while (my $line=<AWS>) {
print $line;
}
close AWS;
$ENV{PKG_CONFIG_PATH}='/usr/local/lib/pkgconfig';
my @creds=();
open(AWS,"(sudo -u ec2-user xauth list 1>&2) 2>&1|");
while (my $line=<AWS>) {
print "WHAT IS THE VALUE=$line\n";
chomp $line;
push @creds, $line;
}
close AWS;
foreach my $cred (@creds) {
system("sudo xauth add $cred");
}
# for gcc compiles (building a program with Gcc and a simple "make"):
# Code: -Wl,-rpath,$(DEFAULT_LIB_INSTALL_PATH)
# This is a good link:
# http://www.tldp.org/HOWTO/Program-Library-HOWTO/shared-libraries.html
$c=<<'END';
bash -c "
cat << EOF > /etc/ld.so.conf.d/gtk.conf
/usr/local/lib
EOF
ldconfig
"
END
open(AWS,"$c|");
while (my $line=<AWS>) {
print $line;
}
close AWS;
system("sudo chmod 444 /etc/ld.so.conf.d/gtk.conf");
my @urls=(
'ftp://ftp.gnu.org/gnu/autoconf/autoconf-2.69.tar.xz',
'http://download.savannah.gnu.org/releases/freetype/freetype-2.4.9.tar.gz',
'http://www.freedesktop.org/software/fontconfig/release/fontconfig-2.9.0.tar.gz',
'http://cairographics.org/releases/pixman-0.26.0.tar.gz',
'http://cairographics.org/releases/cairo-1.12.2.tar.xz',
'http://ftp.gnome.org/pub/gnome/sources/pango/1.30/pango-1.30.0.tar.xz',
'http://ftp.gnome.org/pub/gnome/sources/atk/2.4/atk-2.4.0.tar.xz',
'http://ftp.gnome.org/pub/GNOME/sources/gdk-pixbuf/2.26/gdk-pixbuf-2.26.1.tar.xz',
'http://ftp.gnome.org/pub/gnome/sources/gtk+/2.24/gtk+-2.24.10.tar.xz',
);
my $pkg_config='export PKG_CONFIG_PATH=/usr/local/lib/pkgconfig/';
foreach my $url (@urls) {
my $file=$url;
$file=~s/^.*\/(.*)$/$1/;
my $base=$file;
$base=~s/\.tar\..z$//;
unless (-d $base) {
system("sudo wget $url");
} else { next }
if ($file=~/.xz$/) {
system("sudo tar xvfJ $file");
} else {
system("sudo tar zxvf $file");
}
chdir $base;
system("sudo bash -lc \'$pkg_config;./configure\'");
system("sudo make");
system("sudo make install");
if (-1<index $url,'gtk+') {
chdir 'demos/gtk-demo';
system("sudo make install");
chdir '..';
system("sudo make install");
chdir '..';
system('sudo chmod 755 /usr/local/lib/pkgconfig');
system('sudo cp gtk+-2.0.pc /usr/local/lib/pkgconfig');
my $missing_pc=<<'END';
prefix=/usr/local
exec_prefix=${prefix}
libdir=${exec_prefix}/lib
includedir=${prefix}/include
target=x11
Name: GDK
Description: GTK+ Drawing Kit (${target} target)
Version: 2.24.10
Requires: pango pangocairo gdk-pixbuf-2.0
Libs: -L${libdir} -lgdk-${target}-2.0
Cflags: -I${includedir}/gtk-2.0 -I${libdir}/gtk-2.0/include
END
open(FH,">gdk-x11-2.0.pc");
print FH $missing_pc;
close FH;
system('sudo cp gdk-x11-2.0.pc /usr/local/lib/pkgconfig');
}
system("sudo ldconfig");
chdir '..';
}
system('sudo chmod -Rv 755 /usr/local/lib/pango');
system('sudo chmod -Rv 755 /usr/local/etc/*');
system('sudo bash -lc '.
'"export PKG_CONFIG_PATH=/usr/local/lib/pkgconfig;'.
'perl -MCPAN -e \'install Fatal\'"');
$c=<<'END';
bash -c "
cat << EOF > /etc/ld.so.conf.d/alien.conf
/usr/local/lib64/perl5/Alien/wxWidgets/gtk_3_0_0_uni/lib
EOF
ldconfig
"
END
open(AWS,"$c|");
while (my $line=<AWS>) {
print $line;
}
close AWS;
system("sudo chmod 444 /etc/ld.so.conf.d/alien.conf");
system('sudo bash -lc '.
'"export PKG_CONFIG_PATH=/usr/local/lib/pkgconfig;'.
'perl -MCPAN -e \'install Alien::wxWidgets\'"');
$c=<<'END';
bash -c "
cat << EOF > /etc/ld.so.conf.d/wx.conf
/usr/local/lib64/perl5/auto/Wx
EOF
ldconfig
"
END
open(AWS,"$c|");
while (my $line=<AWS>) {
print $line;
}
close AWS;
system("sudo chmod 444 /etc/ld.so.conf.d/wx.conf");
system('sudo find /usr/local/lib64/perl5 -type d | xargs sudo chmod 755');
system('sudo find /usr/local/share/perl5 -type d | xargs sudo chmod 755');
system('export PKG_CONFIG_PATH=/usr/local/lib/pkgconfig;'.
'perl -MCPAN -e "install Wx::Demo"');
system('sudo find /usr/local/lib64/perl5 -type d | xargs sudo chmod 755');
system('sudo find /usr/local/share/perl5 -type d | xargs sudo chmod 755');
system('/usr/local/bin/wxperl_demo.pl');
system('/usr/local/bin/gtk-demo');
return '<';
};
sub new_user_experience {
print $fa_welcome;
sleep 3;
my $new_user=$_[0]||'';
my $welcome=$_[1]||'';
my $newuser=$_[2]||'';
my $banner='';my $text=[];
my %welcome_menu=();
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_welcome
."\n It appears "
."that $username is new to FullAuto,"
."\n for there is no FullAuto "
."Setup for this user.\n\n";
%welcome_menu=(
Label => 'welcome_menu',
Item_1 => {
Text => "Getting Started (quickly) with FullAuto.\n".
" ".
"Recommended for beginners.\n\n",
Result => $setup_new_user_a,
},
Item_2 => {
Text => ']C[',
Convey => $text,
},
Scroll => 1,
Banner => $banner,
);
} elsif ($welcome) {
$text=[ "Admin Menu",
"User Accounts" ];
$banner=$fa_tutorial
." Please select a subject to explore:";
%welcome_menu=(
Label => 'welcome_menu',
Item_1 => {
Text => ']C[',
Convey => $text,
},
Banner => $banner,
);
}
my $choice=Menu(\%welcome_menu)||'';
if (-1<index $choice,'Create Account') {
print "YEP, CREATE ACCOUNT\n";<STDIN>;
}
}
sub get_amazon_external_ip {
require LWP::UserAgent;
require HTTP::Request;
my $URL='http://169.254.169.254/'.
'latest/meta-data/public-ipv4/';
# $URL='http://www.whatismyip.com';
my $MAX_TRIES=5;
my $SLEEP_BETWEEN_TRIES=20;
my $agent = LWP::UserAgent->new(
env_proxy => 1,
keep_alive => 1,
timeout => 30 );
$agent->agent('Internet Explorer/6.0');
my $header=HTTP::Request->new(GET => $URL);
my $request=HTTP::Request->new('GET',
$URL, $header);
my $response;
my $tries = 1;
do {
$response=$agent->request($request);
if ($response->is_error) {
print "URL: $URL tries: $tries\n";
print "Got Error: " . $response->code .
':' . $response->message. "\n";
$tries++;
if ($tries <= $MAX_TRIES) {
sleep $SLEEP_BETWEEN_TRIES;
}
}
} until (($response->is_success) ||
($tries > $MAX_TRIES));
my $external_IP=$response->content;
if (-1<index $URL,'whatismyip') {
my $content=$external_IP;
$external_IP='';
$content=~s/^.*Your IP:<\/div>.*?([&][#].*?)<\/div>.*$/$1/s;
foreach my $char ($content=~m/(?:[&][#](\d\d);)/g) {
$char=sprintf "%c", $char;
$external_IP.=$char;
}
}
return $external_IP||'';
}
sub check_for_amazon_localhost {
if ($^O eq 'linux') {
if ((-e '/etc/system-release-cpe') &&
(-1<index `cat /etc/system-release-cpe`,'amazon:linux')) {
return ['ami',get_amazon_external_ip()];
} elsif ((-e '/etc/os-release') &&
(-1<index `cat /etc/os-release`,'ubuntu')) {
return ['ubuntu',get_amazon_external_ip()];
} elsif ((-e '/etc/SuSE-release') &&
(-e '/etc/profile.d/amazonEC2.sh')) {
return ['suse',get_amazon_external_ip()];
} elsif ((-e '/etc/system-release-cpe') &&
(-1<index `cat /etc/system-release-cpe`,
'redhat:enterprise_linux')) {
return ['rhel',get_amazon_external_ip()];
} elsif ((-e '/etc/system-release-cpe') &&
(-1<index `cat /etc/system-release-cpe`,
'centos:linux')) {
return ['centos',get_amazon_external_ip()];
} elsif (-e '/etc/gentoo-release') {
return ['gentoo',get_amazon_external_ip()];
}
} elsif ($^O eq 'freebsd' && (-e '/usr/local/bin/aws') &&
(-1<index `cat /usr/local/bin/aws`,'aws.amazon')) {
return ['freebsd',get_amazon_external_ip()];
} return 0;
}
sub numerically { $a <=> $b }
#$Net::FullAuto::FA_Core::debug=1;
#$Net::FullAuto::FA_Core::log=1;
our $gatekeep=sub {
my $href=$_[0];
my $username=$_[1];
my $bdb=$_[2];
my $dbenv=$_[3];
my $label_for_db=$_[4];
my $loop_count=$_[5]||0;
my $errmsg=$_[6]||'';
my $zyxarray=$href->{"passetts_$username"};
$zyxarray=~s/\$ARRAY\d*\s*=\s*//s;
$passetts=eval $zyxarray;
undef $zyxarray;
my $ignore_expiration=$passetts->[1]||0;
my $now=time;
if ($Net::FullAuto::FA_Core::scrub) {
&scrub_passwd_file($label_for_db,$username);
$ignore_expiration=0;
$Net::FullAuto::FA_Core::password_from='user_input';
}
if ($now<$ignore_expiration && !$errmsg) {
$passetts->[2]=$dcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
my $tpess=$dcipher->decrypt($passetts->[0]);
my $skipflag=0;
my $pass=$tpess;
if ($Net::FullAuto::FA_Core::password_from
ne 'user_input') {
if ($passwd[0] ne $tpess) {
undef $tpess;
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[2]=$dcipher=$ecipher;
$skipflag=1;
undef $passwd[0];
} else {
print "\n Saved Password matches ",
"commandline password!\n";
}
}
unless ($skipflag) {
undef $tpess;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet &&
!$Net::FullAuto::FA_Core::gatekeep_expir_shown) {
print "\n Saved Password will Expire: ",
scalar localtime($ignore_expiration)."\n";
$Net::FullAuto::FA_Core::gatekeep_expir_shown=1;
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},
[0,"\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n"])
if $Net::FullAuto::FA_Core::cache;
}
$tpess=$ecipher->encrypt(
$dcipher->decrypt($passetts->[0]));
my $arr=[$tpess,$ignore_expiration];
undef $tpess;
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump($arr)->Out();
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();
my $status=$bdb->db_put($label_for_db,$put_href);
}
$Net::FullAuto::FA_Core::save_main_pass=0;
return $pass;
} elsif ($Net::FullAuto::FA_Core::password_from
ne 'user_input') {
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[2]=$dcipher=$ecipher;
$Net::FullAuto::FA_Core::save_main_pass=1;
my $pass=$passwd[0];
undef $passwd[0];
return $pass;
} else {
if ($errmsg) {
$errmsg=~s/^.*[Pp]assword:\s*$//m;
print " $errmsg";
} elsif ($ignore_expiration) {
print "\n NOTICE!: Saved Password --EXPIRED-- on ".
scalar localtime($ignore_expiration)."\n";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},
[0,"\n NOTICE!: Saved Password --EXPIRED-- on ".
scalar localtime($ignore_expiration)."\n"])
if $Net::FullAuto::FA_Core::cache;
}
my $passwd_timeout=350;
my $pas='';
my $te_time=time;
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
local $SIG{INT} = sub { die "int\n" };
alarm($passwd_timeout);
&acquire_fa_lock(9854);
if ($Net::FullAuto::FA_Core::debug) {
print "\n Local Password for $username (1) : ";
} else {
print "\n Local Password for $username : ";
}
ReadMode 2;
$pas=<STDIN>;
&release_fa_lock(9854);
};alarm(0);
if ($@ eq "alarm\n" or $@ eq "int\n") {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},[0,"\n\n"])
if $Net::FullAuto::FA_Core::cache;
ReadMode 0;
if ($@ eq "alarm\n") {
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');
} else {
&handle_error(
"Interupt Signal Received - FullAuto will exit",
'__cleanup__');
}
}
ReadMode 0;
my $te_time2=time;
if (10<$loop_count
|| (($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},[0,"\n"])
if $Net::FullAuto::FA_Core::cache;
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
$pas=~/^(.*)$/;
$passwd[0]=$1;
chomp($passwd[0]);
print "\n\n";
$passetts->[1]=$Net::FullAuto::FA_Core::choose_pass_expiration->();
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},[0,"\n\n"])
if $Net::FullAuto::FA_Core::cache;
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[2]=$dcipher=$ecipher;
$Net::FullAuto::FA_Core::save_main_pass=1;
my $pass=$passwd[0];
undef $passwd[0];
my @tpass=@{$passetts}[0..1];
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump(\@tpass)->Out();
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();
my $status=$bdb->db_put($label_for_db,$put_href);
return $pass;
}
};
our $determine_password=sub {
my $login_Mast_error=$_[0]||'';
my $loop_count=$_[1]||0;
my $hostlabel=$_[2]||'localhost';
my $password=$_[3]||'';
return if $password;
my $username=&Net::FullAuto::FA_Core::username();
$username=$Net::FullAuto::FA_Core::usrname if
defined $Net::FullAuto::FA_Core::usrname;
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
my $href={};
my $label_for_db=$hostlabel;
if (exists $same_host_as_Master{$hostlabel} ||
$hostlabel eq "__Master_${$}__") {
$label_for_db="localhost_$username";
}
if ($Net::FullAuto::FA_Core::save_main_pass ||
$Net::FullAuto::FA_Core::password_from ne 'user_input'
|| ($login_Mast_error &&
-1<index $login_Mast_error,'Not a GLOB reference')) {
my $status=$bdb->db_get($label_for_db,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
if (exists $href->{"gatekeep_$username"}) {
$gatekeep->($href,$username,$bdb,$dbenv,$label_for_db,
$loop_count,'');
} elsif ($passwd[0]) {
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[2]=$dcipher=$ecipher;
undef $passwd[0];
} else {
my $passwd_timeout=350;
my $pas='';
my $te_time=time;
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);
&acquire_fa_lock(9854);
if ($Net::FullAuto::FA_Core::debug) {
print "\n Local Password for $username (2) : ";
} else {
print "\n Local Password for $username : ";
}
ReadMode 2;
$pas=<STDIN>;
&release_fa_lock(9854);
};alarm(0);
ReadMode 0;
my $te_time2=time;
if ($@ eq "alarm\n") {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},[0,"\n\n"])
if $Net::FullAuto::FA_Core::cache;
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');
}
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},[0,"\n"])
if $Net::FullAuto::FA_Core::cache;
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
$pas||='';
$pas=~/^(.*)$/;
$passwd[0]=$1;
chomp($passwd[0]);
print "\n\n";
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[2]=$dcipher=$ecipher;
undef $passwd[0];
my @tpass=@{$passetts}[0..1];
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump(\@tpass)->Out();
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();
my $status=$bdb->db_put($label_for_db,$put_href);
}
} elsif ((!$Net::FullAuto::FA_Core::dcipher ||
!$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]))
&& !$Net::FullAuto::FA_Core::cron &&
!(exists $Hosts{$hostlabel}{'IdentityFile'} &&
$Hosts{$hostlabel}->{'IdentityFile'})) {
my $passwd_timeout=350;
my $pas='';
my $te_time=time;
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);
&acquire_fa_lock(9854);
if ($Net::FullAuto::FA_Core::debug) {
print "\n Local Password for $username (3): ";
} else {
print "\n Local Password for $username : ";
}
ReadMode 2;
$pas=<STDIN>;
&release_fa_lock(9854);
};alarm(0);
my $te_time2=time;
if ($@ eq "alarm\n") {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},[0,"\n\n"])
if $Net::FullAuto::FA_Core::cache;
&handle_error(
"Input Time Limit for Password Prompt:\n\n".
" Password: Expired");
}
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n<---";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},[0,"\n<---"])
if $Net::FullAuto::FA_Core::cache;
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
$pas=~/^(.*)$/;
$passwd[0]=$1;
chomp($passwd[0]);
my $status=$bdb->db_get($label_for_db,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $pselection='';
my $ignore_expiration=0;
if (exists $href->{"gatekeep_$username"}) {
my $zyxarray=$href->{"passetts_$username"};
$zyxarray=~s/\$ARRAY\d*\s*=\s*//s;
$passetts=eval $zyxarray;
undef $zyxarray;
$ignore_expiration=$passetts->[1]||0;
my $now=time;
my $tdcipher='';
if ($now<$ignore_expiration) {
$tdcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
my $askaboutpass_banner=<<END;
FullAuto has detected a Saved Password from previous invocations that has
NOT yet expired. Please select how FullAuto should proceed . . .
To avoid this screen when using a Saved Password, always be sure to start
FullAuto with the --password argument *WITHOUT* a password after the
argument.
(Saved Passwords are NEVER recommended and are ALWAYS an increased
security risk - but are allowed for unattended mode and for making
interactive use easier and more efficient - like during custom code
development. Always use sparingly.)
(FullAuto also supports command line argument passing of a clear text
password after the --password argument; BUT, know that this is an EVEN
MORE INSECURE and *HIGHLY DISCOURAGED* practice than using Saved
Passwords! Use this approach at YOUR OWN RISK!)
END
if ($passwd[0] eq $tdcipher->decrypt($passetts->[0])) {
my %askaboutpass=(
Item_1 => {
Text => 'Keep the Saved Password',
},
Item_2 => {
Text => 'Discard the Saved Password',
},
Scroll => 1,
Banner => $askaboutpass_banner,
);
$pselection=&Menu(\%askaboutpass);
cleanup() if $pselection eq ']quit[';
}
}
}
my $rstr=new String::Random;
if (exists $Hosts{"__Master_${$}__"}{'Cipher'}
&& $Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[2]=$dcipher=$ecipher;
undef $passwd[0];
if ($pselection ne 'Keep the Saved Password') {
delete $href->{"gatekeep_$username"};
} else {
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print "\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n";
$Net::FullAuto::FA_Core::cache->set(
$Net::FullAuto::FA_Core::cache->{'key'},
[0,"\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n"])
if $Net::FullAuto::FA_Core::cache;
}
my $tpess=$ecipher->encrypt(
$dcipher->decrypt($passetts->[0]));
my $arr=[$tpess,$ignore_expiration];
undef $tpess;
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump($arr)->Out();
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($label_for_db,$put_href);
#print "\n\n" unless $Net::FullAuto::FA_Core::quiet;
} elsif ($passwd[0]) {
my $rstr=new String::Random;
if (exists $Hosts{"__Master_${$}__"}{'Cipher'}
&& $Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[2]=$dcipher=$ecipher;
undef $passwd[0];
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
};
sub loopdir {
my ($dir,$fulldir,$dirtree,$dirpath) = @_;
$dirpath||='';
$dirtree||={};
local(*DIR);
opendir(DIR, "$fulldir$dirpath$dir");
while (my $f=readdir(DIR)) {
next if ($f eq "." || $f eq "..");
if (-d $f) {
$dirpath.="/$f";
$dirtree=&loopdir($f,$dirtree,$dirpath);
} else {
my $dd=$dirpath.$dir;
$dd=~s/\//::/g;
$dd="Net/FullAuto/ISets/$dd/$f";
my $fp=$dd;
if ($dd=~/is[.]pm$/) {
my $nm=$f;
$nm=~s/_is[.]pm$//;
require $dd;
$dd=~s/[.]pm$//;
$dd=~s/\//::/g;
$dd.='::';
my $display='$'.$dd.'DISPLAY';
eval "\$display=$display";
my $connect='$'.$dd.'CONNECT';
$dirtree->{$display}=
[$fp,'$'.$dd,$nm,$connect];
}
}
}
closedir(DIR);
return $dirtree;
}
sub get_isets
{
my $path_to_iset=$_[0]||'';
eval {
die;
};
my $path=$@;
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;
chomp($path);
my $ispath=$path."ISets";
$ispath.='/' if $path_to_iset &&
unpack('a1',$path_to_iset) ne '/';
my $dirtree={};
$dirtree=loopdir($path_to_iset,$ispath,$dirtree);
$Net::FullAuto::ISets=$dirtree;
return $dirtree;
}
my $addprivs=sub {
my $srvaccount=`sc qc sshd`;
$srvaccount=~s/^.*SERVICE_START_NAME : (?:.\\)*(.*?)\s*$/$1/s;
my $rights=`/bin/editrights -u $srvaccount -l 2>&1`;
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=();
my $output='';my $restart_sshd=0;
if (-1<index $rights,'SeDenyRemoteInteractiveLogonRight') {
my $die_deny=<<END;
FATAL ERROR! - The following restriction was
discovered for the sshd service
account $srvaccount :
SeDenyRemoteInteractiveLogonRight
Please contact your Domain and/or System
Administrators for assistance or policy
questions and clarifiations.
END
cleanup();
}
if (-1==index $rights,'SeTcbPrivilege') {
$output=`/bin/editrights -a SeTcbPrivilege -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeTcbPrivilege';
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeCreateTokenPrivilege') {
my $prv='SeCreateTokenPrivilege';
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeCreateTokenPrivilege';
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeAssignPrimaryTokenPrivilege') {
my $prv='SeAssignPrimaryTokenPrivilege';
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeAssignPrimaryTokenPrivilege';
} else { $restart_sshd=1 }
}
if (-1==index $rights,'SeServiceLogonRight') {
my $prv='SeServiceLogonRight';
$output=`/bin/editrights -a $prv -u $srvaccount 2>&1`;
if ($output=~/^Error/) {
push @missing_rights, 'SeServiceLogonRight';
} else { $restart_sshd=1 }
}
if (-1<$#missing_rights) {
my $mis=join "\n",map { " $_" } @missing_rights;
my $die_miss=<<END;
FATAL ERROR! - The following priviliges
are missing from the ID $srvaccount :
$mis
An attempt was made to add these priviliges,
but was not successful. Please contact your
your Domain and/or System Administrators for
assistance. These priviliges can be controlled at
the domain level with a global policy that
affects one or multiple hosts. These policies
are often enforced at host startup - which would
explain why sshd may have worked in an earlier
session, or immediately following installation,
but not after a reboot.
END
print $die_miss;
cleanup();
} elsif ($restart_sshd) {
my $srvout=`/bin/cygrunsrv -Q sshd 2>&1`;
my $output=`net stop sshd 2>&1`;
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";
exit;
}
$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 ",
" could NOT be started:\n\n${srvout}".
"Error: $output\n\nTo restart, Run as Administrator\n".
"\nand then: 'net start sshd'\n\n";
exit;
}
}
}
} return 'return';
};
sub bash_operation_not_permitted {
my $hostlabel=$Hosts{$_[0]}{HostName}||
$Hosts{$_[0]}{IP};
my $looped=$_[1]||0;
my $banner2='';my $result='';
if (exists $same_host_as_Master{$hostlabel}) {
my $srvaccount=`sc qc sshd`;
$srvaccount=~
s/^.*SERVICE_START_NAME : (?:.\\)*(.*?)\s*$/$1/s;
my $account_is_admin=0;
if ($^O eq 'cygwin' &&
can_load(modules => { "Win32::RunAsAdmin" => 0 })) {
$account_is_admin=Win32::RunAsAdmin::check();
}
my $txt1="Attempt to add system privileges\n".
" to ID: $srvaccount";
my $banner3='';
if ($account_is_admin) {
if ($looped==2) {
my $username=&Net::FullAuto::FA_Core::username();
chomp($username);
my $windows_login=`tasklist /V | /bin/grep dwm`;
$windows_login=~s/^.*Running\s+(.*)\s+\d+:.*$/$1/;
$windows_login=~s/^.*\\(.*)$/$1/;
$windows_login=~s/\s*$//s;
if ($windows_login eq $username) {
$banner3=<<END;
FATAL ERROR! : The attempt to add priviliges to the
ID: $srvaccount.
did not succeed.
HINT: Please contact your Domain and/or System Administrators
for assistance or questions and clarifiations.
END
print $banner3;
cleanup();
} else {
$banner3=<<END;
FATAL ERROR! : The attempt to add priviliges to the ID:
$srvaccount did not succeed.
HINT: It appears you are running FullAuto from a terminal started with
elevated prililiges using ID: $username, and your Windows Desktop
login is $windows_login. You may be able to update priviliges
from a Desktop session using $username. Log out of your current
Desktop session, and login in as $username (if allowed).
Once logged in you can either run FullAuto again, or use gpedit.msc.
1. Click Start, click Run, type gpedit.msc, and then click OK.
2. Expand Local Computer Policy, expand Computer Configuration,
expand Windows Settings, expand Security Settings, expand
Local policies, and then click User Rights Assignment.
3. Double-click Log on as a batch job, click Add user or group,
type the name of the service account, and then click OK two times.
4. Double-click Log on as a service, click Add user or group,
type the name of the service account, and then click OK two times.
OR - contact your Domain and/or System Administrators
for assistance or policy questions and clarifiations.
END
print $banner3;
cleanup();
}
} else {
$banner3=<<END;
FullAuto can attempt to add the missing system
privileges to the ID: $srvaccount.
END
$result={
Name => 'result',
Item_1 => {
Text => $txt1,
Result => $addprivs,
},
Item_2 => {
Text => 'Exit FullAuto',
},
Scroll => 1,
Banner => $banner3,
};
}
} else {
$banner3=<<END;
No attempt was made to add these priviliges, because
the user \'$username\' lacks sufficient administrative
rights on this host. Please contact your Domain and/or
System Administrators for assistance.
HINT: If you have an ID with administrator priviliges,
exit Windows and login with that ID instead, or
when opening any program in Windows, (including
a Cygwin Terminal) right click on icon and select
"Run as administrator"
END
$result={
Name => 'result',
Banner => $banner3,
};
}
$banner2=<<END;
There may be system priviliges missing from the ID: $srvaccount
needed for the Cygwin sshd service on $hostlabel.
FullAuto by default attempts to fork a local SSH process to act as a
parent for SFTP. An option to fork a local BASH shell process is also
available, but SSH is default because it is more secure, and it enables
shelling out from SFTP to the local system, which does not work from a
BASH shell process. All other SFTP functionality on remote hosts is
available however. In situations like this where a local SSHD service is
not available, forking a BASH shell is a viable alernative. To use BASH
shell parenting, add this line to your host block configurations:
Spawn => 'bash',
END
} else {
$banner2=<<END;
FATAL ERROR! : /bin/bash: Operation not permitted
There may be system priviliges missing from the
account needed for the sshd service on $hostlabel.
Please contact your Domain and/or System Administrators
for assistance. These priviliges may be controlled at
the domain level with a global policy that affects
one or multiple hosts.
END
$result=sub { cleanup() };
}
my $banner=<<END;
FATAL ERROR! : /bin/bash: Operation not permitted
This error is usually a result of the sshd
service account on $hostlabel not having proper
privileges. For a more detailed explanation,
type 2 and press ENTER.
END
my %bsp=(
Name => 'bsp',
Banner => $banner2,
Result => $result,
);
my %bonp=(
Name => 'bonp',
Item_1 => {
Text => 'Exit FullAuto',
Result => sub { cleanup() },
},
Item_2 => {
Text => 'Detailed Explanation',
Result => \%bsp,
},
Scroll => 1,
Banner => $banner,
);
my $timeout=350;my $returned='';
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB:
# \n required
alarm($timeout);
$returned=Menu(\%bonp);
print "\n";
};alarm(0);
cleanup() unless $returned eq 'return';
return;
}
sub log
{
my $log=$Net::FullAuto::FA_Core::log||0;
$log=$_[0] if defined $_[0] && $_[0];
return 1 if $log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $logcount=0;
$logcount=$_[1] if defined $_[1] && $_[1];
my $cache=$_[2]||'';
my $logdir='';
if (exists $Hosts{"__Master_${$}__"}{'LogFile'}
&& $Hosts{"__Master_${$}__"}{'LogFile'}) {
if (substr($Hosts{"__Master_${$}__"}{'LogFile'},0,1) eq '~') {
$Hosts{"__Master_${$}__"}{'LogFile'}=~s/^[~]/$home_dir/;
}
$LOG=*LOG;
my $die="Cannot Open LOGFILE - \"" .
$Hosts{"__Master_${$}__"}{'LogFile'} . "\"";
$logdir=$Hosts{"__Master_${$}__"}{'LogFile'};
if ($logdir=~/[\/|\\]/) {
$logdir=~s/^(.*)[\/|\\].*$/$1/;
} else {
$logdir=cwd();
}
umask 0027;
sysopen($LOG,$Hosts{"__Master_${$}__"}{'LogFile'}
,(O_WRONLY|O_CREAT)) # write mode,
|| &handle_error($!);# create if needed
unless ($quiet) {
print "\n LOGFILE ==> \"",
$Hosts{"__Master_${$}__"}{'LogFile'},"\"\n";
$cache->set($cache->{'key'},
[0,"\n LOGFILE ==> \"",
$Hosts{"__Master_${$}__"}{'LogFile'},"\"\n"])
if $cache;
}
$LOG->autoflush(1);
my $trace = Devel::StackTrace->new();
print $LOG "\n\n#### NEW PROCESS - ",
scalar localtime(time)," #####\n\n",
"#### COMMAND - $0 ",
(join " ",map { (-1<index $_,' ')?"\"$_\"":$_ } @ARGV),
" ####\n\n";
print "\nINFO: log() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nlog() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n";
} elsif ($log) {
$Net::FullAuto::FA_Core::log=$log
unless $Net::FullAuto::FA_Core::log;
$LOG=*LOG;
my $olog='';
umask 0027;
if ($log!~/^\d$/) {
if ($log!~/\//) {
$olog=$home_dir."/$log";
$logdir=$home_dir;
} elsif ($log=~/\/$/) {
$olog=$log."FAlog${$}d".
$Net::FullAuto::FA_Core::invoked[2].
$Net::FullAuto::FA_Core::invoked[3].".txt";
$logdir=$log;
}
} else {
mkdir "$home_dir/.fullauto" unless
-d "$home_dir/.fullauto";
chmod 0770, "$home_dir/.fullauto";
mkdir "$home_dir/.fullauto/logs" unless
-d "$home_dir/.fullauto/logs";
chmod 0770, "$home_dir/.fullauto/logs";
$logdir="$home_dir/.fullauto/logs";
$olog=$home_dir."/.fullauto/logs/FAlog${$}d".
$Net::FullAuto::FA_Core::invoked[2].
$Net::FullAuto::FA_Core::invoked[3].".txt";
}
$Hosts{"__Master_${$}__"}{'LogFile'}=$olog;
sysopen($LOG,$olog,(O_WRONLY|O_CREAT)) # write mode,
|| &handle_error($!);# create if needed
$LOG->autoflush(1);
unless ($quiet) {
print "\n LOGFILE ==> \"$olog\"\n";
$cache->set($cache->{'key'},
[0,"\n LOGFILE ==> \"$olog\"\n"])
if $cache;
}
my $trace = Devel::StackTrace->new();
print $LOG "\n\n#### NEW PROCESS - ",
scalar localtime(time)," #####\n\n",
"#### COMMAND - $0 ",
(join " ",map { (-1<index $_,' ')?"\"$_\"":$_ } @ARGV),
" ####\n\n";
print "\nINFO: log() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nlog() (((((((CALLER))))))):\n ",
$trace->as_string(),"\n\n";
} else {
$LOG='';
return 0;
}
if ($logdir && ((exists $Hosts{'localhost'}{'LogCount'} &&
$Hosts{'localhost'}{'LogCount'} &&
$Hosts{'localhost'}{'LogCount'}=~/^\d+$/) || $logcount)) {
my @logs=();
eval {
@logs=`ls -t $logdir`;
};
if ($@) {
print $LOG "Cannot Read Contents of LOGDIR $logdir=$@\n"
if $log && -1<index $LOG,'*';
}
my $count=$logcount||$Hosts{'localhost'}{'LogCount'};
my $logcount=$#logs;
$count--;
if ($count<$logcount) {
foreach my $log (reverse @logs) {
chomp $log;
next if $log eq '.';
next if $log eq '..';
eval {
unlink $logdir.'/'.$log;
};
if ($@) {
print $LOG "Cannot Remove Logfiles=$@\n"
if $log && -1<index $LOG,'*';
}
last if $count >= --$logcount;
}
}
}
return 1;
}
sub connect_berkeleydb
{
my @topcaller=caller;
print "main::connect_berkeleydb() for $_[0] CALLER="
,(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "main::connect_berkeleydb() CALLER=",
(join ' ',@topcaller),"\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $dbname=$_[0];
my $lc_dbname=lc($dbname);
my $mkdflag=0;
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
my $track='';
my $mr="__Master_".$$."__";
unless (exists $Net::FullAuto::FA_Core::Hosts{$mr}
{'berkeley_db_path'}) {
if (-w "/var/db/Berkeley/FullAuto") {
$Hosts{"__Master_${$}__"}{'berkeley_db_path'}=
"/var/db/Berkeley/FullAuto/";
} else {
my $home_dir=File::HomeDir->my_home.'/';
mkdir "$home_dir/.fullauto" unless
-d "$home_dir/.fullauto";
chmod 0770, "$home_dir/.fullauto";
mkdir "$home_dir/.fullauto/db" unless
-d "$home_dir/.fullauto/db";
chmod 0770, "$home_dir/.fullauto/db";
$Hosts{"__Master_${$}__"}{'berkeley_db_path'}
="$home_dir/.fullauto/db/";
}
}
unless (-d $Hosts{$mr}{'berkeley_db_path'}.$dbname) {
$mkdflag=1;
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
$m.$Hosts{$mr}{'berkeley_db_path'}.$dbname;
my $stdout='';my $stderr='';
($stdout,$stderr)=&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
&handle_error($stderr) if $stderr;
if ($m) {
my $cd=cwd();
chdir $m.$Hosts{$mr}{'berkeley_db_path'}.$dbname;
my $cmd=$Net::FullAuto::FA_Core::gbp->('bash').
'bash -c "umask u=rwx,g=rwx,o=rwx"';
($stdout,$stderr)=&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
chdir $cd;
}
} elsif ($^O eq 'cygwin' &&
!(-e $Hosts{$mr}{'berkeley_db_path'}.$dbname.'/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_$lc_dbname.db")) {
$mkdflag=1;
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{$mr}{'berkeley_db_path'}.$dbname,
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL,
-LockDetect => DB_LOCK_DEFAULT
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_$lc_dbname.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
#$bdb->db_close();
#undef $bdb;
#$dbenv->close();
#undef $dbenv;
my $d=&Net::FullAuto::FA_Core::find_berkeleydb_utils('recover');
my $cmd="$d -h ".$Hosts{$mr}{'berkeley_db_path'}.$dbname;
my $out=`$cmd`;
&handle_error($out) if $out;
#$dbenv = BerkeleyDB::Env->new(
# -Home => $Hosts{"__Master_${$}__"}{'berkeley_db_path'}.$dbname,
# -Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL,
# -LockDetect => DB_LOCK_DEFAULT
#) or &handle_error(
# "cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_$lc_dbname.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB:".
"${Net::FullAuto::FA_Core::progname}_${kind}_$lc_dbname.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
# print the contents of the file
if ($mkdflag && $^O eq 'cygwin') {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod')."chmod -Rv $mode ".
$Hosts{$mr}{'berkeley_db_path'}.$dbname.'/'.
"${Net::FullAuto::FA_Core::progname}_${kind}_$lc_dbname.db";
my ($stdout,$stderr)=&Net::FullAuto::FA_Core::setuid_cmd($cmd,5);
&handle_error($stderr) if $stderr && -1==index $stderr,'mode of';
}
return $dbenv,$bdb;
}
sub fa_login
{
if (defined $_[0] && $_[0]=~/^\d+$/) {
$timeout=$_[0];
} else {
my $time_out='$' . (caller)[0] . '::timeout';
$time_out= eval $time_out;
$time_out||=30;
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;
} else { $timeout=$time_out }
} $test=0;$prod=0;
###################################
# The following are being set if
# found defined in Term::Menus
my $log_='$' . (caller)[0] . '::log';
$log_= eval $log_;
$log_=0 if $@ || !$log_;
my $tosspass_='$' . (caller)[0] . '::tosspass';
$tosspass_= eval $tosspass_;
$tosspass_=0 if $@ || !$tosspass_;
## end Term::Menus defs ###########
my $fhtimeout='X';
my $fatimeout=$timeout;
my $tst='$' . (caller)[0] . '::test';
$tst=eval $tst;
$test=$tst if !$@ || $tst=~/^[1-9]+/;
my $_connect='connect_ssh_telnet';
if (exists $Hosts{"__Master_${$}__"}{'Local'}) {
my $loc=$Hosts{"__Master_${$}__"}{'Local'};
unless ($loc eq 'connect_ssh'
|| $loc eq 'connect_telnet'
|| $loc eq 'connect_ssh_telnet'
|| $loc eq 'connect_telnet_ssh') {
my $die="\n FATAL ERROR - \"Local\" has "
."*NOT* been Properly\n Defined in the "
."\"$Net::FullAuto::FA_Core::fa_host\" File."
."\n This "
."Element must have one of the following\n"
." Values:\n\n "
." 'connect_ssh'or 'connect_telnet'\n "
." 'connect_ssh_telnet' or\n "
." 'connect_telnet_ssh'\n\n"
." \'$loc\' is INCORRECT.\n\n";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} elsif ($loc eq 'connect_ssh') {
$_connect=$loc;
@RCM_Link=('ssh');
} elsif ($loc eq 'connect_telnet') {
$_connect=$loc;
@RCM_Link=('telnet');
} elsif ($loc eq 'connect_ssh_telnet') {
$_connect=$loc;
@RCM_Link=('ssh','telnet');
} else {
$_connect=$loc;
@RCM_Link=('telnet','ssh');
}
} else {
@RCM_Link=('ssh','telnet');
$Hosts{"__Master_${$}__"}{'Local'}=$_connect;
}
$email_defaults='%' . (caller)[0] . '::email_defaults';
%email_defaults=eval $email_defaults;
if ($@) {
$email_defaults=0;
%email_defaults=();
} else { $email_defaults=1 }
my $email_addresses='%' . (caller)[0] . '::email_addresses';
%email_addresses=eval $email_addresses;
%email_addresses=() if $@;
my $test_caller=(caller)[0];
$custom_code_module_file='$' . (caller)[0] . '::fa_code';
$custom_code_module_file=eval $custom_code_module_file;
if ($@) {
my $die="Cannot Locate the \"FullAuto Custom Code\" "
."perl module (.pm) file\n < original "
."default name 'fa_code.pm' >\n\n $@";
&handle_error($die,'-3');
}
my $man=0;my $help=0;my $userflag=0;my $passerror=0;
my $test_arg=0;my $oldcipher='';
my @holdARGV=@ARGV;@menu_args=();my $username_from='';
my $cust_subnam_in_fa_code_module_file;my $sem='';
my $sshport='';
Getopt::Long::Configure ("bundling");
&GetOptions(
'admin' => \$admin,
'menu' => \$menu,
'welcome' => \$welcome,
'new_user' => \$newuser,
'newuser' => \$newuser,
'new-user' => \$newuser,
'iset-amazon:s' => \$iset_amazon,
'iset-local:s' => \$iset_local,
'amazon-cleanup' => \$amazoncleanup,
'tutorial' => \$tutorial,
'figlet' => \$figlet,
'g' => \$go,
'go' => \$go,
'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,
'identity-file=s' => \$identityfile,
'identityfile=s' => \$identityfile,
'log:s' => \$log,
'l:s' => \$log,
man => \$man,
'password:s' => \$passwrd,
'pw:s' => \$passwrd,
'password_no_warning:s' => \$passwrdnw,
'pwnw:s' => \$passwrdnw,
'quiet' => \$quiet,
'oldpassword=s' => \$oldpasswd,
'oldcipher=s' => \$oldcipher,
'updatepw' => \$updatepw,
'local-login-id:s' => \$usrname,
'localid:s' => \$usrname,
'local_id:s' => \$usrname,
'local-id:s' => \$usrname,
'login:s' => \$usrname,
'loginid:s' => \$usrname,
'login_id:s' => \$usrname,
'login-id:s' => \$usrname,
'id:s' => \$usrname,
'username:s' => \$usrname,
'user:s' => \$usrname,
'u:s' => \$usrname,
'code=s' => \$cust_subnam_in_fa_code_module_file,
'c=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_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);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;
@ARGV=@holdARGV;undef @holdARGV;
$random='__random__' if $random;
if (defined $log) { $log=1 }
$log=$log_ if !$log;
$tosspass=$tosspass_ if !$tosspass;
if ($test_arg) {
$prod=0;$test=1;
} elsif ($prod) {
$test=0;
}
my $track=0;
if (defined $passwrd) {
if ($passwrd) {
my $warn_against_commandline_password=<<END;
WARNING! A cleartext password is being passed to FullAuto via
commandline argument. This is a VERY insecure and *HIGHLY
DISCOURAGED* practice. It is suggested to use Saved Passwords
instead which is more secure, and does not leave cleartext
passwords in the process table, invocation history, volatile
memory and log files.
Use the --password (or --pw) argument with *NO* password after
it, and follow the online instructions that will appear when
you this method of invocation.
It is *STRONGLY* advised that you change your password BEFORE
saving since the current one was used insecurely.
If you still want to pass cleartext passwords on the commandline
and not see this warning, use the --password_no_warning or
--pwnw arguments (followed by the password) instead.
Use at YOUR OWN RISK!
END
warn $warn_against_commandline_password;
$passwd[0]=$passwrd;
$Net::FullAuto::FA_Core::password_from='cmd_line_arg';
} else {
$Net::FullAuto::FA_Core::save_main_pass=1;
} undef $passwrd;
} elsif (defined $passwrdnw) {
if ($passwrdnw) {
$passwd[0]=$passwrdnw;
$Net::FullAuto::FA_Core::password_from='cmd_line_arg';
} else {
$Net::FullAuto::FA_Core::save_main_pass=1;
} undef $passwrdnw;
} elsif (defined $go) {
$Net::FullAuto::FA_Core::save_main_pass=1;
}
my $uname_uid=getlogin || getpwuid($<);
my $launch_local_ssh_telnet=0;
if (defined $usrname) {
$username=$usrname;
$launch_local_ssh_telnet=1 if $username ne $uname_uid;
$username_from='cmd_line_arg';
$userflag=1;
} elsif (defined $go) {
$username=&Net::FullAuto::FA_Core::username();
$launch_local_ssh_telnet=1 if $username ne $uname_uid;
$username_from='go_arg_current';
$userflag=1;
} else {
my $force_login=0;
($username,$force_login)=&Net::FullAuto::FA_Core::username();
$launch_local_ssh_telnet=1 if ($username ne $uname_uid)
|| $force_login;
$userflag=1 unless $force_login;
$username_from='from_uid' if $userflag;
}
if (defined $identityfile && $identityfile) {
$Hosts{"__Master_${$}__"}{'IdentityFile'}=$identityfile;
} elsif (exists $Hosts{'localhost'}{'IdentityFile'}) {
$Hosts{"__Master_${$}__"}{'IdentityFile'}=
$Hosts{'localhost'}{'IdentityFile'};
}
if ($Hosts{"__Master_${$}__"}{'IdentityFile'} &&
!(-r $Hosts{"__Master_${$}__"}{'IdentityFile'})) {
my $i=$Hosts{"__Master_${$}__"}{'IdentityFile'};
my $login_Mast_error=
"SSH identity_file $i cannot be read.";
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";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
}
if (-1<$#_ && $_[0] && $_[0]!~/^\d+$/) {
if ($#_ && $#_%2!=0) {
my $key='';my $margs=0;
foreach my $arg (@_) {
if (!$key) {
$key=$arg;next;
} else {
if ($key eq 'local-login-id') {
$username=$arg;
} elsif ($key eq 'login') {
$username=$arg;
} elsif ($key eq 'password') {
$Net::FullAuto::FA_Core::password_from='fa_login_arg';
$arg=~/^(.*)$/;
$passwd[0]=$1;
} elsif ($key eq 'sub_arg' ||
$key eq 'sub-arg') {
@menu_args=() if !$margs;
$margs=1;
push @menu_args, $arg;
} elsif ($key ne 'test' || $prod==0) {
${$key}=$arg;
} $key='';
}
}
} else {
&handle_error("Wrong Number of Arguments to &fa_login");
}
} elsif (!$prod && defined $_[1] &&
(!defined $_[0] || !$_[0] || $_[0]=~/^\d+$/)) {
$test=$_[1];
}
#$passwd[1]=$passwd[0];
#if (exists $Hosts{"__Master_${$}__"}{'Cipher'} &&
# $Hosts{"__Master_${$}__"}{'Cipher'}
# =~/$Net::FullAuto::FA_Core::crypt_cipher/
# && 7<length $passwd[0]) {
#$passwd[1]=unpack('a8',$passwd[0])
#}
if (defined $cron) {
if ($cron) {
$plan=$cron;
}
$batch=']Batch[';
$unattended=']Unattended[';
$fullauto=']FullAuto[';
$cron=']Cron[';
}
my $cache='';
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 $die if (!$cron && $debug) && !$quiet;
exit 1;
} elsif (defined $cache_root && $cache_root && -d $cache_root) {
$cache=cache('cache',$cache_root);
if ($cache->chi_root_class) {
if (defined $cache_key && $cache_key) {
$cache->{'key'}=$cache_key;
}
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 $die if (!$cron && $debug) && !$quiet;
exit 1;
}
} else {
my $die="\n FATAL ERROR - No cache root dir defined "
."for cache.\n\n"
." at ".__PACKAGE__." Line: "
.__LINE__."\n\n";
print $die if (!$cron && $debug) && !$quiet;
exit 1;
}
} elsif (defined $cache_key && $cache_key) {
$cache=cache('cache');
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 $die if (!$cron && $debug) && !$quiet;
exit 1;
}
$cache->{'key'}=$cache_key;
} last if $cache;
}
}
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n Starting $progname . . .\n";
$cache->set($cache->{'key'},[0,"\n Starting $progname . . .\n"])
if $cache;
}
sleep 2 if $Net::FullAuto::FA_Core::debug;
my $su_scrub='';my $login_Mast_error='';my $id='';my $use='';
my $hostlabel='';my $mainuser='';my $retrys='';
my $su_err='';my $su_id='';my $stdout='';my $stderr='';
my $hostname='';my $fullhostname='';my $passline='';
my $host=''; my $cmd_type='';my $cmd_pid='';my $login_id;
my $password='';
if (exists $Hosts{"__Master_${$}__"}{'HostName'} &&
-1<index $Hosts{"__Master_${$}__"}{'HostName'},'.') {
$hostname=substr($Hosts{"__Master_${$}__"}{'HostName'},0
,(index $Hosts{"__Master_${$}__"}{'HostName'},'.'))||'';
$fullhostname=$Hosts{"__Master_${$}__"}{'HostName'};
} else {
$fullhostname=$hostname=$Hosts{"__Master_${$}__"}{'HostName'}||'';
}
my $ip=inet_ntoa((gethostbyname($hostname))[4])||'';
my $suroot='';
foreach my $host (keys %same_host_as_Master) {
next if $host eq "__Master_${$}__";
if (exists $Hosts{$host}{'LoginID'} &&
($Hosts{$host}{'LoginID'} eq $username)) {
$su_id='' if !$mainuser;
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};
$mainuser=1;
if (exists $Hosts{$host}{'SU_ID'}) {
$su_id=$Hosts{$host}{'SU_ID'};
$hostlabel=$host;
$suroot=(getgrnam('suroot'))[3];
last if $su_id eq 'root';
} next
} elsif (!$mainuser && exists $Hosts{$host}{'SU_ID'}) {
$su_id=$Hosts{$host}{'SU_ID'};
$suroot=(getgrnam('suroot'))[3];
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};
$hostlabel=$host;
} else {
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};
} $hostlabel=$host if !$hostlabel;
} $hostlabel="__Master_${$}__" if !$hostlabel;
$master_hostlabel=$hostlabel;$hostlabel="__Master_${$}__";
$Hosts{$hostlabel}{'Uname'}=$^O;
if ($cltimeout ne 'X') {
$fatimeout=$fhtimeout=$cltimeout;
} elsif ($fhtimeout ne 'X') {
$fatimeout=$fhtimeout;
} $retrys=0;
#foreach my $key (keys %same_host_as_Master) {
# if (exists $Hosts{$key}{'berkeley_db_path'}) {
# $Hosts{$key}{'berkeley_db_path'}.='/' if
# substr($Hosts{$key}{'berkeley_db_path'},-1) ne '/';
# $Hosts{"__Master_${$}__"}{'berkeley_db_path'}=
# $Hosts{$key}{'berkeley_db_path'};
# last
# }
#}
#my $FA_Core_path='';
#foreach my $key (keys %INC) {
# if (-1<index $key,'FA_Core.pm') {
# $FA_Core_path=substr($INC{$key},0,(rindex $INC{$key},'/')+1);
# last;
# }
#} $Hosts{"__Master_${$}__"}{'FA_Core'}=$FA_Core_path;
#if (!exists $Hosts{"__Master_${$}__"}{'berkeley_db_path'}) {
# unless (-d '/var/db/Berkeley/FullAuto') {
# my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
# my $m=($^O eq 'cygwin')?"-m $mode ":'';
# unless (-d '/var/db') {
# my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
# $m.'/var/db';
# my $stdout='';my $stderr='';
# ($stdout,$stderr)=&setuid_cmd($cmd,5);
# &handle_error($stderr) if $stderr;
# }
# unless (-d '/var/db/Berkeley') {
# my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
# $m.'/var/db/Berkeley';
# my $stdout='';my $stderr='';
# ($stdout,$stderr)=&setuid_cmd($cmd,5);
# &handle_error($stderr) if $stderr;
# }
# unless (-d '/var/db/Berkeley/FullAuto') {
# my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').'mkdir -p '.
# $m.'/var/db/Berkeley/FullAuto';
# my $stdout='';my $stderr='';
# ($stdout,$stderr)=&setuid_cmd($cmd,5);
# &handle_error($stderr) if $stderr;
# }
# }
# if (!(-d '/var/db/Berkeley/FullAuto' && -w _)) {
# &handle_error("Cannot Write to Berkeley FullAuto Directory :".
# "\n\n ".
# '/var/db/Berkeley/FullAuto');
# }
# $Hosts{"__Master_${$}__"}{'berkeley_db_path'}=
# '/var/db/Berkeley/FullAuto/';
#} elsif (!(-d $Hosts{"__Master_${$}__"}{'berkeley_db_path'} && -w _)) {
# handle_error("Cannot Write to Berkeley FullAuto Directory :".
# "\n\n ".
# $Hosts{"__Master_${$}__"}{'berkeley_db_path'});
#} else {
# $Hosts{"__Master_${$}__"}{'berkeley_db_path'}.='/' if
# substr($Hosts{"__Master_${$}__"}{'berkeley_db_path'},-1) ne '/';
#}
if ($updatepw) {
my $uid=$username;
while (1) {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
}
if ($login_Mast_error) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n ERROR MESSAGE (4) -> $login_Mast_error";
} else {
print "\n ERROR MESSAGE -> $login_Mast_error";
}
}
if ($test && !$prod) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n Running in TEST (1) mode\n";
} else {
print "\n Running in TEST mode\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;
my $usrname='';
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($usrname_timeout);
&acquire_fa_lock(1234);
my $ikey='';
print "\n";
($usrname,$ikey)=rawInput(" $hostname Login <$uid> : ");
&release_fa_lock(1234);
};alarm(0);
if ($@ eq "alarm\n") {
print "\n\n";
&handle_error(
"Time Allowed for Username Input has Expired.",
'__cleanup__');
}
chomp $usrname;
$usrname=~s/^\s*//s;
$usrname=~s/\s*$//s;
next if $usrname=~/^\d/ || !$usrname && !$uid;
$username= ($usrname) ? $usrname : $uid;
$username_from='user_input';
$userflag=1;
last;
}
while (1) {
print "\n Enter Old Password: ";
ReadMode 2;
&release_fa_lock(1234);
my $pas=<STDIN>;
$pas=~/^(.*)$/;
$passwd[0]=$1;
&acquire_fa_lock(1234);
ReadMode 0;
chomp($passwd[0]);
print "\n\n";
$passwd[1]=$passwd[0];
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/
&& 7<length $passwd[0]) {
$passwd[1]=unpack('a8',$passwd[0])
}
print " Please Enter Old Password Again: ";
ReadMode 2;
&release_fa_lock(1234);
$pas=<STDIN>;
$pas=~/^(.*)$/;
$passwd[3]=$1;
&acquire_fa_lock(1234);
ReadMode 0;
chomp($passwd[3]);
print "\n\n";
$passwd[4]=$passwd[3];
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/
&& 7<length $passwd[3]) {
$passwd[4]=unpack('a8',$passwd[3])
}
if ($passwd[1] eq $passwd[4]) {
last;
} else {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
} print "\n Passwords did not match!\n";
}
}
while (1) {
print "\n Enter New Password: ";
ReadMode 2;
&release_fa_lock(1234);
$passwd[5]=<STDIN>;
&acquire_fa_lock(1234);
ReadMode 0;
chomp($passwd[5]);
print "\n\n";
$passwd[6]=$passwd[5];
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/
&& 7<length $passwd[5]) {
$passwd[6]=unpack('a8',$passwd[5])
}
print " Please Enter New Password Again: ";
ReadMode 2;
&release_fa_lock(1234);
$passwd[7]=<STDIN>;
&acquire_fa_lock(1234);
ReadMode 0;
chomp($passwd[7]);
print "\n\n";
$passwd[8]=$passwd[7];
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/
&& 7<length $passwd[7]) {
$passwd[8]=unpack('a8',$passwd[7])
}
if ($passwd[6] eq $passwd[8]) {
last;
} else {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
} print "\n Passwords did not match!\n";
}
}
my $cipher_algorithm=($oldcipher)?$oldcipher:
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'};
my $cipher = new Crypt::CBC($passwd[8],
$cipher_algorithm);
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
my $href=eval $v;
foreach my $key (keys %{eval $v}) {
if ($key=~/\d+$/) {
while (delete $href->{$key}) {}
next
}
my $href_2='';
my $status=$bdb->db_get($k,$href_2);
my $encrypted_passwd=$href_2->{$key};
my $pass=$cipher->decrypt($encrypted_passwd);
if ($pass && $pass!~tr/\0-\37\177-\377//) {
print "Updated $key\n";
while (delete $href->{$key}) {}
my $cipher = new Crypt::CBC($passwd[8],
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
my $new_encrypted=$cipher->encrypt($pass);
$href->{$key}=$new_encrypted;
} else { print "Skipping $key\n" }
} my $put_href=Data::Dump::Streamer::Dump($href)->Out();
my $status=$bdb->db_put($k,$put_href);
}
$cursor->c_close();
undef $cursor ;
$bdb->db_close();
undef $bdb ;
$dbenv->close();
undef $dbenv;
&cleanup();
}
&acquire_fa_lock(9876);
my $loop_count=0;
while (1) {
$loop_count++;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
my $logdir='';
if (!$LOG) {
Net::FullAuto::FA_Core::log();
}
if (-r "/tmp/fa_aws_home.txt") {
open(RD,"/tmp/fa_aws_home.txt");
my $credentials_csv_path=<RD>;
close RD;
$credentials_csv_path=~s/\s*$//;
if (-e "$credentials_csv_path/credentials.csv") {
my $cred_ts=stat("$credentials_csv_path/credentials.csv");
opendir(DH,$credentials_csv_path);
while (my $line=readdir(DH)) {
chomp $line;
if ($line=~/\.pem/) {
my $pem_ts=stat("$credentials_csv_path/$line");
$Hosts{"__Master_${$}__"}{'IdentityFile'}
="$credentials_csv_path/$line"
if $pem_ts->[9] <= $cred_ts->[9];
$iset_amazon=1 unless $amazoncleanup;
$username=&Net::FullAuto::FA_Core::username();
$userflag=1;
$authorize_connect=1;
last;
}
}
}
} elsif (defined $iset_amazon) {
test_for_amazon_ec2();
unless (%main::amazon) {
my $die="FATAL ERROR - Amazon EC2 Cloud Network"
." NOT Detected.\n\n "
." Must be on EC2 Instance to use --iset-amazon\n";
&handle_error($die);
}
}
if (($Term::Menus::new_user_flag or $welcome or $newuser) &&
!$default && !$iset_amazon && !$iset_local &&
!$amazoncleanup) {
$Net::FullAuto::FA_Core::skip_host_hash=1;
&new_user_experience($Term::Menus::new_user_flag,
$welcome,$newuser);
}
if (defined $default || (defined $facode && !$facode)
|| (defined $faconf && !$faconf)
|| (defined $fahost && !$fahost)
|| (defined $famenu && !$famenu)
|| (defined $set && !$set)) {
my $default_modules=$main::get_default_modules->();
if (defined $facode) {
my %define_module_fa_code=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Code'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Code'),
);
my $selection=Menu(\%define_module_fa_code);
&cleanup();
} elsif (defined $faconf) {
my %define_module_fa_conf=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Conf'),
);
my $selection=Menu(\%define_module_fa_conf);
&cleanup();
} elsif (defined $fahost) {
my %define_module_fa_host=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Host'),
);
my $selection=Menu(\%define_module_fa_host);
&cleanup();
} elsif (defined $famenu) {
my %define_module_fa_menu=(
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => $fasetdef,
},
Banner => $fabann->($default_modules,'Menu'),
);
my $selection=Menu(\%define_module_fa_menu);
&cleanup();
} elsif (defined $set) {
$default_modules->{'set'}||='none';
my $current_default_set=$default_modules->{'set'};
&Menu($set_menu_sub->());
}
if (defined $famenu) {
set_fa_modules('menu',$default_modules);
} elsif (defined $facode) {
set_fa_modules('code',$default_modules);
} elsif (defined $fahost) {
set_fa_modules('host',$default_modules);
} elsif (defined $faconf) {
set_fa_modules('conf',$default_modules);
} elsif (defined $default) {
my $ca_sub=sub {
use File::Path;
use File::Copy;
my $type=$_[0];
my $username=&Net::FullAuto::FA_Core::username();
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);
unless (-d "$fadir/Custom/$username/$type") {
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
unless (-d "$fadir/Custom") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."$fadir/Custom";
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
}
unless (-d "$fadir/Custom/$username") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."$fadir/Custom/$username";
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
}
unless (-d "$fadir/Custom/$username/$type") {
my $cmd=$Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m."$fadir/Custom/$username/$type";
my $stdout='';my $stderr='';
($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
}
my $cmd=$Net::FullAuto::FA_Core::gbp->('cp').'cp '.
"$fadir/Custom/fa_".lc($type).'.pm '.
"$fadir/Custom/$username/$type";
($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr;
if ($^O eq 'cygwin') {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $cmd=$Net::FullAuto::FA_Core::gbp->('chmod').
"chmod -Rv $mode ".
"$fadir/Custom/$username/$type/*";
my ($stdout,$stderr)=&setuid_cmd($cmd,5);
die $stderr if $stderr && -1==index $stderr,'mode of';
}
}
opendir(DIR,"$fadir/Custom/$username/$type");
my @xfiles = readdir(DIR);
my @return=();
closedir(DIR);
foreach my $entry (@xfiles) {
next if $entry eq '.';
next if $entry eq '..';
next if -d $entry;
push @return, $entry;
}
return @return;
};
$defaults_sub->($default_modules);
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
my $selection=Menu($viewdefaults_sub->());
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults') ||
($selection eq 'Finished Default Module')) {
&cleanup();
}
#print "SELECTION=$selection\n";sleep 5;
} else {
my $selection=Menu($defaultsettings_sub->());
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults')) {
&cleanup();
}
}
}
}
if ($plan || $plan_ignore_error) {
if ($Net::FullAuto::cpu) {
my $idle=(split ',', $Net::FullAuto::cpu)[3];
$idle=~s/^\s*//;
$idle=~s/%.*$//;
my $cpyou=100-$idle;
if ($idle<20) {
my $die="FATAL ERROR - CPU Usage is too high\n"
." to run FullAuto safely.\n"
." CPU are Starttime ==> ${cpyou}%\n";
&handle_error($die);
}
}
$plan||=$plan_ignore_error;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Plans');
my $pref='';
my $status=$bdb->db_get($plan,$pref);
$pref=~s/\$HASH\d*\s*=\s*//s;
my $pla_n=eval $pref;
unless (ref $pla_n eq 'HASH' and exists $pla_n->{Plan}) {
my $die="\n FATAL ERROR! - Plan $plan is *NOT* a"
."\n Valid FullAuto Plan. Please indicate\,"
."\n a Valid Plan, or Create one using the"
."\n --plan argument without a number.\n"
."\n $status\n";
print $LOG $die
if $log && -1<index $LOG,'*';
&handle_error($die,'__cleanup__');
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
if ($admin && !defined $main::plan_menu_sub) {
$Net::FullAuto::FA_Core::adminmenu->();
}
if ($localhost &&
(-1<index $login_Mast_error,'invalid log'
&& -1<index $login_Mast_error,'ogin incor'
&& -1<index $login_Mast_error,'sion den') ||
(-1<index $login_Mast_error,'/dev/tty: No')) {
if ($cmd_type eq 'telnet' &&
defined fileno $localhost->{_cmd_handle}) {
$localhost->{_cmd_handle}->print("\003");
$localhost->{_cmd_handle}->print(' exit');
while (defined fileno $localhost->{_cmd_handle}) {
while (my $line=$localhost->{_cmd_handle}->get) {
print $LOG "FA_LOGINTRYINGTOKILL=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$line=~s/\s//g;
my $allout.=$line;
last if $allout=~/logout|closed/s;
} $localhost->{_cmd_handle}->close;
}
} elsif ($cmd_type eq 'ssh') {
$localhost->{_cmd_handle}->print("\003");
$localhost->{_cmd_handle}->print("\003");
$localhost->{_cmd_handle}->close;
} elsif (exists $localhost->{_cmd_handle}) {
$localhost->{_cmd_handle}->close;
}
}
if ($login_Mast_error) {
if ($login_Mast_error=~/[Ll]ogin|sion den|Passwo/) {
$userflag=0;@passwd=();
chomp($login_Mast_error);
$login_Mast_error=~s/^(.*try again.).*$/$1\n/s;
$login_Mast_error=~s/^debug1.*interactive\s*//s;
} else {
chomp($login_Mast_error);
}
}
if ((!$userflag && !$cron) ||
(defined $usrname && !$usrname) || $launch_local_ssh_telnet) {
my $uid=getlogin || getpwuid($<);
$launch_local_ssh_telnet=1;
if (!$Net::FullAuto::FA_Core::cron && !$usrname) {
while (1) {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
}
if ($login_Mast_error) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n ERROR MESSAGE (5) -> $login_Mast_error";
} else {
print "\n ERROR MESSAGE -> $login_Mast_error";
}
}
if ($test && !$prod) {
if ($Net::FullAuto::FA_Core::debug) {
print "\n Running in TEST (2) mode\n";
} else {
print "\n Running in TEST mode\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
print "\n Running in PRODUCTION (2) mode\n";
} else {
print "\n Running in PRODUCTION mode\n";
}
}
my $usrname_timeout=350;
my $usrname='';
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($usrname_timeout);
&acquire_fa_lock(1234);
my $ikey='';
print "\n";
($usrname,$ikey)=rawInput(" $hostname Login <$uid> : ");
&release_fa_lock(1234);
};alarm(0);
if ($@ eq "alarm\n") {
print "\n\n";
&handle_error(
"Time Allowed for Username Input has Expired.",
'__cleanup__');
}
chomp $usrname;
$usrname=~s/^\s*//s;
$usrname=~s/\s*$//s;
next if $usrname=~/^\d/ || !$usrname && !$uid;
$username= ($usrname) ? $usrname : $uid;
$username_from='user_input';
$userflag=1;
last;
}
} elsif ($login_Mast_error &&
(-1==index $login_Mast_error,'/dev/tty: No')) {
&handle_error($login_Mast_error);
} else {
if (defined $usrname) {
$username=$usrname;
$launch_local_ssh_telnet=1 if $username ne $uname_uid;
$username_from='cmd_line_arg';
$userflag=1;
} elsif (defined $go) {
$username=&Net::FullAuto::FA_Core::username();
$launch_local_ssh_telnet=1 if $username ne $uname_uid;
$username_from='go_arg_current';
$userflag=1;
} else {
my $force_login=0;
($username,$force_login)=&Net::FullAuto::FA_Core::username();
$launch_local_ssh_telnet=1 if ($username ne $uname_uid)
|| $force_login;
$userflag=1 unless $force_login;
$username_from='from_uid' if $userflag;
}
}
}
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
my $mkdflag=0;
$login_id=$username;
$passwd[2]='';
$host='localhost';
my $lc_cnt=-1;
$localhost={};my $local_host='';
$localhost=bless $localhost, 'Rem_Command';
bless $localhost,
substr($Net::FullAuto::FA_Core::custom_code_module_file,0,-3);
&acquire_fa_lock(6543);
my $ignore='';my $href={};my $newpw='';
if ($launch_local_ssh_telnet) {
foreach my $connect_method (@RCM_Link) {
$lc_cnt++;
if (lc($connect_method) eq 'telnet') {
$cmd_type='telnet';
my $telnetpath=$Net::FullAuto::FA_Core::gbp->('telnet');
my $telnetport='';
if (exists $Hosts{"__Master_${$}__"}{'telnetport'}) {
$telnetport=$Hosts{"__Master_${$}__"}{'telnetport'};
}
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"));
} 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"));
}
$localhost->{_cmd_pid}=$cmd_pid;
$localhost->{_cmd_type}=$cmd_type;
$localhost->{_ftp_type}='';
$localhost->{_connect}=$_connect;
$localhost->{_uname}=$^O;
$localhost->{_homedir}=File::HomeDir->my_home.'/';
$localhost->{_hostlabel}=
[ "__Master_${$}__",'' ];
$local_host=Net::Telnet->new(Fhopen => $localhost,
Timeout => $fatimeout);
$local_host->telnetmode(0);
$local_host->binmode(1);
$local_host->output_record_separator("\r");
$localhost->{_cmd_handle}->close()
if exists $localhost->{_cmd_handle};
delete $localhost->{_cmd_handle}
if exists $localhost->{_cmd_handle};
$localhost->{_cmd_handle}=$local_host;
while (my $line=$local_host->get) {
$line=~tr/\0-\37\177-\377//d;
chomp($line);
#print "OUTPUT FROM NEW::TELNET=$line<==\n";
#print $Net::FullAuto::FA_Core::LOG "OUTPUT FROM NEW::TELNET=$line<==\n";
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (7<length $line && unpack('a8',$line) eq 'Insecure') {
$line=~s/^Insecure/INSECURE/s;
if (wantarray) {
&release_fa_lock(6543);
return '',$line;
} else { &release_fa_lock(6543);die $line }
}
last if $line!~/Last login/i &&
$line=~/login[: ]*$|username[: ]*$/i;
}
$local_host->print($login_id);
if ($local_host->errmsg) {
&release_fa_lock(6543);
&handle_error($local_host->errmsg,'-1')
}
## Wait for password prompt.
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
$localhost,$timeout,'',$login_Mast_error,
$loop_count);
if ($stderr) {
if ($lc_cnt==$#RCM_Link) {
&release_fa_lock(6543);
die $stderr;
} else { next }
} last
} elsif (lc($connect_method) eq 'ssh') {
$cmd_type='ssh';
if (exists $Hosts{"__Master_${$}__"}{'sshport'}) {
$sshport=$Hosts{"__Master_${$}__"}{'sshport'};
}
my $try_count=0;my $v='vvv';
while (1) {
if ($sshport) {
if (exists $Hosts{"__Master_${$}__"}{'IdentityFile'}
&& $Hosts{"__Master_${$}__"}{'IdentityFile'}) {
my $i=$Hosts{"__Master_${$}__"}{'IdentityFile'};
if ($Net::FullAuto::FA_Core::debug) {
$v='v' if $^O eq 'freebsd';
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh',"-p$sshport","-i$i",
"-$v","$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh','-v',"-p$sshport","-i$i",
"$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
}
} elsif (-1<index $login_Mast_error,'/dev/tty: No') {
if ($Net::FullAuto::FA_Core::debug) {
$v='v' if $^O eq 'freebsd';
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -p$sshport -$v $login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -p$sshport -v $login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$v='v' if $^O eq 'freebsd';
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh',"-p$sshport",
"-$v","$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh','-v',"-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"));
}
}
} elsif (exists $Hosts{"__Master_${$}__"}{'IdentityFile'}
&& $Hosts{"__Master_${$}__"}{'IdentityFile'}) {
my $i=$Hosts{"__Master_${$}__"}{'IdentityFile'};
if (-1<index $login_Mast_error,'/dev/tty: No') {
if ($Net::FullAuto::FA_Core::debug) {
$v='v' if $^O eq 'freebsd';
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -$v -i $i $login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -v -i $i $login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$v='v' if $^O eq 'freebsd';
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh',"-$v","-i$i",
"$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh','-v',"-i$i",
"$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
}
}
} else {
if (-1<index $login_Mast_error,'/dev/tty: No') {
if ($Net::FullAuto::FA_Core::debug) {
$v='v' if $^O eq 'freebsd';
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -$v $login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -v $login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$v='v' if $^O eq 'freebsd';
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh',"-$v","$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
'ssh','-v',"$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
}
}
}
$localhost->{_cmd_pid}=$cmd_pid;
print $Net::FullAuto::FA_Core::LOG
"SSH_Pid=$cmd_pid at Line ", __LINE__,"<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$localhost->{_cmd_type}=$cmd_type;
$localhost->{_ftp_type}='';
$localhost->{_connect}=$_connect;
$localhost->{_uname}=$^O;
$localhost->{_homedir}=File::HomeDir->my_home.'/';
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];
$local_host=Net::Telnet->new(Fhopen => $local_host,
Timeout => $fatimeout);
$local_host->telnetmode(0);
$local_host->binmode(1);
$local_host->output_record_separator("\r");
$localhost->{_cmd_handle}->close()
if exists $localhost->{_cmd_handle};
$localhost->{_cmd_handle}=$local_host;
## Wait for password prompt.
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$local_host,
_hostlabel=>[ "__Master_${$}__",'' ],
_cmd_type=>'ssh',
_connect=>$_connect },$timeout,'',
$login_Mast_error,$loop_count);
if ($stderr) {
if ($lc_cnt==$#RCM_Link) {
&release_fa_lock(6543);
die $stderr;
} elsif (-1<index $stderr,'/dev/tty: No') {
&release_fa_lock(6543);
die "can\'t open /dev/tty: ".
"No such device or address\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;
($stdout,$stderr)=&kill($cmd_pid,$kill_arg)
if &testpid($cmd_pid);
$Net::FullAuto::FA_Core::slave='_slave_';next
} elsif (3<$try_count++) {
&release_fa_lock(6543);
&Net::FullAuto::FA_Core::handle_error($stderr)
} else { sleep 1;next }
} last
} last
}
}
} else {
($local_host,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','','','',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch bash subprocess"));
$local_host=Net::Telnet->new(Fhopen => $local_host,
Timeout => $timeout);
$local_host->telnetmode(0);
$local_host->binmode(1);
$local_host->output_record_separator("\r");
$local_host->prompt("/_funkyPrompt_\$/");
$local_host->print(
" export PS1=_funkyPrompt_;unset PROMPT_COMMAND");
$localhost->{_cmd_handle}->close()
if exists $localhost->{_cmd_handle};
$local_host->print();my $out='';
while (my $line=$local_host->get(Timeout=>$timeout)) {
$out.=$line;
last if $out=~/_funkyPrompt_\s*$/;
select(undef,undef,undef,0.02); # sleep for 1/50th second;
$local_host->print();
}
$localhost->{_cmd_handle}=$local_host;
$localhost->{_cmd_pid}=$cmd_pid;
$localhost->{_connect}='connect_shell';
$localhost->{_cmd_type}='bash';
$localhost->{_ftp_type}='';
$localhost->{_uname}=$^O;
$localhost->{_homedir}=File::HomeDir->my_home.'/';
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];
}
## Send password.
print $Net::FullAuto::FA_Core::LOG "PRINTING PASSWORD NOW<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($launch_local_ssh_telnet) {
if ($dcipher && !$ignore) {
#print "WHAT IS PASSWORD=",$dcipher->decrypt($passetts->[0]),"\n";sleep 3;
$local_host->print($dcipher->decrypt($passetts->[0]));
}
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
if ($^O ne 'cygwin') {
print $blanklines;
$cache->set($cache->{'key'},[0,$blanklines]) if $cache;
} else {
unless ($login_Mast_error) {
print "\n\n";
$cache->set($cache->{'key'},[0,"\n\n"])
if $cache;
}
}
# Logging (1)
unless ($login_Mast_error) {
print "--> Logging into $host via $cmd_type",
" . . .\n\n" unless $login_Mast_error;
$cache->set($cache->{'key'},
[0,"--> Logging into $host via $cmd_type".
" . . .\n\n"])
if $cache;
}
} elsif ($Net::FullAuto::FA_Core::debug) {
if ($login_Mast_error) {
print "LOGIN MASTER HOST ERROR: ",
"$login_Mast_error\n";
$cache->set($cache->{'key'},
[0,"LOGIN MASTER HOST ERROR: ".
"$login_Mast_error\n"])
if $cache;
}
print "--> Logging (1) into $host via $cmd_type",
" . . .\n\n";
$cache->set($cache->{'key'},
[0,"--> Logging (1) into $host via $cmd_type",
" . . .\n\n"])
if $cache;
}
$passline=__LINE__+1;
unless ($ignore && $ignore=~/[:\$%>#-] ?/s) {
while (my $line=$local_host->get) {
print "WAITING FOR CMDPROMPT=$line<== at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"WAITING FOR CMDPROMPT=$line<== at Line: ",__LINE__,"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $output='';
($output=$line)=~s/login:.*//s;
if ($^O eq 'cygwin') {
my $pass_test=$dcipher->decrypt($passetts->[0]);
$pass_test=~s/[(]/\\(/g;
$pass_test=~s/[)]/\\)/g;
if ($line=~/^$pass_test\n/) {
undef $pass_test;
$local_host->print("\032");
$local_host->close;
$passerror=1;
&release_fa_lock(6543);
return;
} else {
undef $pass_test;
}
}
if ($line=~/Permission denied|Password:/s) {
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
my $status=$bdb->db_get('localhost',$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
if (exists $href->{"gatekeep_$username"}) {
my $tdcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
if ($dcipher->decrypt($passetts->[0]) eq
$tdcipher->decrypt($passetts->[0])) {
delete $href->{"gatekeep_$username"};
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put('localhost',$put_href);
}
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
## ADD - TELL USER ABOUT MISSING CRON CREDS ON CMD LINE
&release_fa_lock(6543);
die $line;
} elsif (-1<index $line,'/bin/bash: Operation not permitted') {
Net::FullAuto::FA_Core::bash_operation_not_permitted(
$hostlabel);
}
if ($line=~/Connection reset by peer|node or service name/s) {
&release_fa_lock(6543);
die $line;
}
if ($line=~/(?<!Last )login[: ]*$/m ||
(-1<index $line,' sync_with_child: ')) {
&release_fa_lock(6543);
&handle_error($output,'__cleanup__');
}
if ($line=~/new password: ?$/is) {
$newpw=$line;
print $Net::FullAuto::FA_Core::LOG "GOING LAST ONE<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last;
}
if ($^O eq 'cygwin') {
if ($line=~/[:\$%>#-] ?$/m &&
unpack('a10',$line) ne 'Last Login') {
print $Net::FullAuto::FA_Core::LOG "GOING LAST TWO<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last;
}
} elsif ($line=~/[:\$%>#-] ?/m &&
(-1==index $line,'Authenticated to') &&
($line!~/^debug\d+:/)) {
print $Net::FullAuto::FA_Core::LOG "<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last
}
print $Net::FullAuto::FA_Core::LOG "BOTTOM OF WHILE<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
}
print $Net::FullAuto::FA_Core::LOG "GOT OUT OF COMMANDPROMPT<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&release_fa_lock(6543);
&change_pw($localhost) if $newpw;
## Make sure prompt won't match anything in send data.
$local_host->prompt("/_funkyPrompt_\$/");
$local_host->print(" export PS1=_funkyPrompt_;unset PROMPT_COMMAND");
$localhost->{_ftp_type}='';
$localhost->{_cwd}='';
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];
$localhost->{_hostname}=$hostname;
$localhost->{_ip}=$ip;
$localhost->{_connect}=$_connect;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);
&handle_error($cfh_error,'-1') if $cfh_error;
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;
}
}
if (exists $Hosts{"__Master_${$}__"}{'SU_ID'}) {
my $ignore='';my $su_err='';
my $su_id=$Hosts{"__Master_${$}__"}{'SU_ID'};
&release_fa_lock(6543);
($ignore,$su_err)=&su($localhost->{_cmd_handle},$hostlabel,
$username,$su_id,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);
&handle_error($su_err,'-1') if $su_err;
&acquire_fa_lock(6543);
}
}
my $wloop=0;
($stdout,$stderr)=Rem_Command::cmd(
$localhost,'export HISTCONTROL="ignorespace"');
while (1) {
my $_sh_pid='';
($_sh_pid,$stderr)=Rem_Command::cmd(
$localhost,'echo $$');
# --CONTINUE-- print "LOCAL_sh_pid=$_sh_pid<==\n";
print $Net::FullAuto::FA_Core::LOG "LOCAL_sh_pid=$_sh_pid<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$_sh_pid||=0;
$_sh_pid=~/^(.*)$/;
$_sh_pid=$1||'';
$_sh_pid=~tr/\0-\11\13-\37\177-\377//d;
chomp($_sh_pid);
$localhost->{_sh_pid}=$_sh_pid;
print $Net::FullAuto::FA_Core::LOG "ERROR LOCALLLLLLLLLLLLLLLLLLLL_sh_pid=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$localhost->{_sh_pid}) {
$localhost->print;
$localhost->print(' '.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;echo $$;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');
my $allins='';my $ct=0;
while (1) {
eval {
while (my $line=$localhost->get(
Timeout=>5)) {
$line=~tr/\0-\37\177-\377//d;
chomp($line);
$allins.=$line;
print $Net::FullAuto::FA_Core::LOG "PID_line_sh_pid_1=$allins<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($allins=~/!!(.*)%%/) {
$localhost->{_sh_pid}=$1;
print $Net::FullAuto::FA_Core::LOG
"PID_line_sh_pid_2=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last;
}
}
};
print $Net::FullAuto::FA_Core::LOG "FORCING_sh_pid=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($@) {
$localhost->print;
} elsif (!$localhost->{_sh_pid} && $ct++<50) {
$localhost->print;
} else { last }
}
print $Net::FullAuto::FA_Core::LOG
"PID_out_of_WHILE_sh_pid=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
} else { last }
last if $localhost->{_sh_pid} && $localhost->{_sh_pid}=~/^\d+$/;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);
&handle_error($cfh_error,'-1') if $cfh_error;
if ($stderr || $wloop++==10) {
&handle_error($stderr);
}
}
if ($launch_local_ssh_telnet) {
&su_scrub($hostlabel) if $su_scrub;
my $switch_user='';
if (!$mainuser && (exists $Hosts{$hostlabel}{'LoginID'}) &&
($Hosts{$hostlabel}{'LoginID'} ne $login_id)) {
$switch_user=$Hosts{$hostlabel}{'LoginID'};
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt(
&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$switch_user,'',$stderr,
'__su__'));
$passetts->[2]=$dcipher=$ecipher;
$login_id=$username=$switch_user;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);
&handle_error($cfh_error,'-1') if $cfh_error;
}
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
my $local_host_flag=0;
my $host__label='';
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
# --CONTINUE-- print "WHAT ARE HOSTLAB that are SAME AS MASTER=$hostlab<==\n";
next if $hostlab eq "__Master_${$}__";
$host__label=$hostlab;
$local_host_flag=1;
last;
}
if (!$local_host_flag) {
$host__label=$Net::FullAuto::FA_Core::local_hostname;
$local_host_flag=1;
}
} elsif (exists $same_host_as_Master{$hostlabel}) {
$local_host_flag=1;
$host__label=$hostlabel;
} else { $host__label=$hostlabel }
my $key='';
if ($local_host_flag) {
$key="${login_id}_X_"
."${host__label}_X_${$}_X_$invoked[0]";
} else {
$key="${username}_X_${login_id}_X_${host__label}";
}
my $lref={};
my $status=$bdb->db_get($host__label,$lref);
$lref=~s/\$HASH\d*\s*=\s*//s;
print $Net::FullAuto::FA_Core::LOG "LREF=$lref<==\n if ref $lref eq 'HASH"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$lref=eval $lref;
foreach my $ky (keys %{$lref}) {
if ($ky eq $key) {
while (delete $lref->{$key}) {}
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $lref->{$ky}) {}
}
}
unless ($tosspass || $ignore) {
my $cipher='';my $mr="__Master_".$$."__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
if (8<length $dcipher->decrypt($passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC($dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC($dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
my $new_encrypted=$cipher->encrypt(
$dcipher->decrypt($passetts->[0]));
print $Net::FullAuto::FA_Core::LOG "\nFA_LOGIN__NEWKEY=$key<== and HOST__LABEL=$host__label\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$lref->{$key}=$new_encrypted;
my $put_lref=Data::Dump::Streamer::Dump($lref)->Out();
my $status=$bdb->db_put($host__label,$put_lref);
print $Net::FullAuto::FA_Core::LOG "BDB STATUS=$status<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
} elsif (!$ignore) {
$tosspass{$key}=$dcipher->decrypt($passetts->[0]);
}
if (!$identityfile && $Net::FullAuto::FA_Core::save_main_pass) {
$passetts->[1]=$Net::FullAuto::FA_Core::choose_pass_expiration->();
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print "\n Saved Password will Expire: ",
scalar localtime($passetts->[1])."\n";
$cache->set($cache->{'key'},
[0,"\n Saved Password will Expire: ".
scalar localtime($passetts->[1])."\n"])
if $cache;
sleep 2;
}
my @tpass=@{$passetts}[0..1];
my $status=$bdb->db_get('localhost',$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump(\@tpass)->Out();
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put('localhost',$put_href);
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
if ($switch_user) {
my $ignore='';
($ignore,$su_err)=&su($local_host,$hostlabel,
$username,$switch_user,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);
&handle_error($su_err,'-1') if $su_err;
}
if (($^O ne 'cygwin') && $su_id) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle(
$local_host);
&handle_error($cfh_error,'-1')
if $cfh_error;
my $ignore='';
($ignore,$su_err)=&su($local_host,$hostlabel,
$login_id,$su_id,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);
&handle_error($su_err,'-1') if $su_err;
}
}
if ($^O eq 'cygwin') {
my $wloop=0;
while (1) {
&acquire_fa_lock(8712);
($localhost->{_cygdrive},$stderr)=
Rem_Command::cmd(
$localhost,
$Net::FullAuto::FA_Core::gbp->('mount')."mount -p");
&release_fa_lock(8712);
$localhost->{_cygdrive}=~s/^.*(\/\S+).*$/$1/s;
last if $localhost->{_cygdrive} && unpack('a1',
$localhost->{_cygdrive}) eq '/';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle(
$local_host);
&handle_error($cfh_error,'-1')
} $localhost->{_cygdrive_regex}=
qr/^$localhost->{_cygdrive}\//;
}
$localhost->{_work_dirs}=&master_transfer_dir(
$localhost);
if ($^O eq 'cygwin') {
$localhost->{_cwd}=$localhost->{_work_dirs}->{_pre_mswin};
} else {
$localhost->{_cwd}=$localhost->{_work_dirs}->{_pre};
}
if ($su_id) {
$Connections{"__Master_${$}____%-$su_id"}
=$localhost;
} else {
$Connections{"__Master_${$}____%-$login_id"}
=$localhost;
}
};
if ($passerror) {
$passerror=0;next;
} elsif ($@) {
if (7<length $@) {
if (unpack('a8',$@) eq 'Insecure') {
print $@;cleanup();
} elsif (unpack('a8',$@) eq 'INSECURE') {
$@=~s/INSECURE/Insecure/s;
}
}
$username=&Net::FullAuto::FA_Core::username()
|| "Intruder!!" if !$username;
$login_id=$username if !$login_id;
$login_Mast_error=$@;
$localhost->{_sh_pid}||='';
$localhost->{_cmd_pid}||='';
my $kill_arg=($^O eq 'cygwin')?'f':9;
if ((-1<index $@,'Not a GLOB reference') ||
(-1<index $@,'Connection reset by peer')) {
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
unless ($localhost->{_sh_pid}) {
my $pspath=$Net::FullAuto::FA_Core::gbp->('ps');
my $ps_out=`${pspath}ps -el`;
print $Net::FullAuto::FA_Core::LOG
"\nHERE IS THE PS CMD OUTPUT:\n ",
"$ps_out\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
foreach my $line (reverse split "\n", $ps_out) {
if (substr($line,-4) eq 'bash') {
my $pid=$line;
($pid=$line)=~s/^(\d+) .*$/$1/;
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$pid,$kill_arg);
last;
}
}
} else {
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$localhost->{_sh_pid},$kill_arg)
if exists $Net::FullAuto::FA_Core::localhost->{_sh_pid}
&& &Net::FullAuto::FA_Core::testpid(
$localhost->{_sh_pid});
}
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$localhost->{_cmd_pid},$kill_arg)
if &Net::FullAuto::FA_Core::testpid(
$localhost->{_cmd_pid});
$retrys++;next;
} elsif ((-1<index $@,'Address already in use' ||
-1<index $@,'Connection refused')
&& $retrys<2) {
my $warn="$@\n Waiting ".int $fatimeout/3
." seconds for re-attempt . . .\n "
.($!);
warn $warn if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;
print $LOG $warn
if $log && -1<index $LOG,'*';
sleep int $fatimeout/3;$retrys++;next;
} elsif (-1<index $@,'/dev/tty: No') {
print $LOG $@
if $log && -1<index $LOG,'*';
next;
} elsif (!$Net::FullAuto::FA_Core::cron ||
(unpack('a3',$@) eq 'pid') ||
(-1<index $login_Mast_error,$passline)) {
if ($retrys<2 && -1<index $login_Mast_error,'timed-out') {
#print $Net::FullAuto::FA_Core::LOG "WE ARE RETRYING LOGINMASTERERROR=$login_Mast_error\n";
my $pspath=$Net::FullAuto::FA_Core::gbp->('ps');
my $psoutput=`${pspath}ps`;
#print $Net::FullAuto::FA_Core::LOG "PSOUTPUTTTTTTTTTTTT=$psoutput<==\n";
$retrys++;
if (-1<index $login_Mast_error,'read') {
next;
} else {
$login_Mast_error.="\n $host - is visible on the "
."network,\n but the Telnet Server is NOT "
."RESPONDING.\n Check the availability of Telnet "
."Service on\n $host before continuing"
." ...\n\n";
}
}
#LOGINMASTERERROR=Can't locate object method "cmd" via package "fa_code_demo"
# at /usr/lib/perl5/site_perl/5.10/Net/FullAuto/FA_Core.pm line 4759.
#
# THIS ERROR OCCURS WHEN THE FILENAME AND PACKAGE NAME DIFFER
#print "LOGINMASTERERROR=$login_Mast_error\n";sleep 5;
$Net::FullAuto::FA_Core::dcipher='';
if ($login_Mast_error=~/invalid log|ogin incor|sion den|Passwo/) {
if (($^O eq 'cygwin')
&& 2<=$retrys) {
$login_Mast_error.="\n WARNING! - You may be in"
." Danger of locking out MS Domain "
."ID - $login_id!\n\n";
if ($retrys==3) {
$su_scrub=&scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} elsif (2<=$retrys) {
$login_Mast_error.="\n WARNING! - You may be in"
." Danger of locking out $^O "
."localhost ID - $login_id!\n\n";
if ($retrys==3) {
$su_scrub=&scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} else { $retrys++;next }
} elsif ($login_Mast_error=~/Input Time Limit/) {
#print $login_Mast_error if (!$Net::FullAuto::FA_Core::cron ||
# $Net::FullAuto::FA_Core::debug) &&
# !$Net::FullAuto::FA_Core::quiet;
#print $LOG $login_Mast_error
# if $log && -1<index $LOG,'*';
&Net::FullAuto::FA_Core::handle_error(
$login_Mast_error,'__cleanup__');
} elsif ($su_id &&
-1<index($login_Mast_error,'ation is d')) {
$su_scrub=&scrub_passwd_file($hostlabel,$su_id);
next;
} elsif (defined $Net::FullAuto::FA_Core::dcipher &&
$Net::FullAuto::FA_Core::dcipher) {
#print "DOING PASSWD UPDATE\n";
&passwd_db_update($hostlabel,$login_id,$password,
$cmd_type,$sshport);
}
}
my $c_t=$cmd_type;$c_t=~s/^(.)/uc($1)/e;
my $die="\n FATAL ERROR! - The Host $host Returned"
."\n the Following Unrecoverable Error Condition\,"
."\n Rejecting the $c_t Login Attempt of the ID"
."\n -> $login_id :\n\n "
."$login_Mast_error\n";
print $die if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;
print $LOG $die
if $log && -1<index $LOG,'*';
die $die;
#&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} last;
}
if (defined $plan_ignore_error && !$plan_ignore_error) {
$Net::FullAuto::FA_Core::makeplan=&plan();
cleanup() if $Net::FullAuto::FA_Core::makeplan eq ']quit[';
} elsif (defined $plan && !$plan) {
$Net::FullAuto::FA_Core::makeplan=&plan();
cleanup() if $Net::FullAuto::FA_Core::makeplan eq ']quit[';
} elsif ($plan || $plan_ignore_error) {
$plan||=$plan_ignore_error||='';
my $plan_num=$plan;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Plans');
my $pref='';
my $status=$bdb->db_get($plan_num,$pref);
$pref=~s/\$HASH\d*\s*=\s*//s;
$plan=eval $pref;
if (exists $plan->{Expires} && $plan->{Expires} ne 'never'
&& $plan->{Expires}<time()) {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
localtime($plan->{Expires});
my $m=$month[$mon];$m=~s/\s*$//;
$year += 1900;
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";
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 $die if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;
print $LOG $die
if $log && -1<index $LOG,'*';
cleanup();
}
$plan=$plan->{Plan};
} elsif (defined $iset_amazon &&
can_load(modules => { "Net::FullAuto::Cloud::fa_amazon" => 0 })) {
Net::FullAuto::Cloud::fa_amazon::new_user_amazon(
$Hosts{"__Master_${$}__"}{'IdentityFile'},$menu_args[0],$menu_args[1]);
} elsif (defined $iset_local &&
can_load(modules => { "Net::FullAuto::Cloud::fa_local" => 0 })) {
Net::FullAuto::Cloud::fa_local::iset($iset_local);
} elsif ($amazoncleanup &&
can_load(modules => { "Net::FullAuto::Cloud::fa_amazon" => 0 })) {
Net::FullAuto::Cloud::fa_amazon::new_user_amazon(
$Hosts{"__Master_${$}__"}{'IdentityFile'},$menu_args[0],$menu_args[1],
'__cleanup__');
}
return $cust_subnam_in_fa_code_module_file, \@menu_args, $fatimeout, $cache;
} ## END of &fa_login
sub fa_set {
my $vlin=__LINE__;
#####################################################################
#### ###
#### 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_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;
if (-e $f.'/Net/FullAuto.pm') {
$INC{'Net/FullAuto.pm'}=$f.'/Net/FullAuto.pm';
last;
}
}
}
my $fa_path=$INC{'Net/FullAuto.pm'};
substr($fa_path,-3)='';
chomp($fa_path);
my $net_path=$fa_path;
$net_path=~s/Net\/.*$//;
my %fullpath_files=();
my $default_modules='';
unless ($main::fa_code && $main::fa_conf && $main::fa_host
&& $main::fa_menu) {
my $progname=substr($0,(rindex $0,'/')+1,-3);
if (-f $fa_path.'/fa_global.pm') {
if (-r $fa_path.'/fa_global.pm') {
{
no strict 'subs';
require $fa_path.'/fa_global.pm';
$fa_global::berkeley_db_path||='';
if ($fa_global::berkeley_db_path &&
-d $fa_global::berkeley_db_path.'Defaults') {
BEGIN { $Term::Menus::facall=caller(2);
$Term::Menus::facall||='' };
use if (-1<index $Term::Menus::facall,'FullAuto'),
"BerkeleyDB";
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Defaults');
my $username=getlogin || getpwuid($<);
if (exists $ENV{'SSH_CONNECTION'} &&
exists $ENV{'USER'} && ($ENV{'USER'}
ne $username)) {
$username=$ENV{'USER'};
} elsif ($username eq 'SYSTEM' &&
exists $ENV{'IWUSER'} && ($ENV{'IWUSER'}
ne $username)) {
my $login_flag=0;
foreach (@ARGV) {
my $argv=$_;
if ($login_flag) {
$username=$argv;
last;
} elsif (lc($argv) eq '--login') {
$login_flag=1;
}
}
$username=$ENV{'IWUSER'} unless $login_flag;
}
my $status=$bdb->db_get(
$username,$default_modules) if $bdb;
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';
$default_modules=eval $default_modules;
$default_modules||={};
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
unless (keys %{$default_modules}) {
$default_modules->{'set'}='none';
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
} elsif (exists $default_modules->{'set'} &&
$default_modules->{'set'} ne 'none') {
my $setname=$default_modules->{'set'};
my ($stenv,$std)=
Net::FullAuto::FA_Core::connect_berkeleydb('Sets');
my $username=&Net::FullAuto::FA_Core::username();
my $set='';
my $status=$std->db_get(
$username,$set);
$set||='';
$set=~s/\$HASH\d*\s*=\s*//s
if -1<index $set,'$HASH';
$set=eval $set;
$set||={};
undef $std;
$stenv->close();
undef $stenv;
$fa_code=[$set->{$setname}->{'fa_code'},
"From Default Set $setname ".
"(Change with fa --set)"];
$fa_conf=[$set->{$setname}->{'fa_conf'},
"From Default Set $setname ".
"(Change with fa --set)"];
$fa_host=[$set->{$setname}->{'fa_host'},
"From Default Set $setname ".
"(Change with fa --set)"];
$fa_menu=[$set->{$setname}->{'fa_menu'},
"From Default Set $setname ".
"(Change with fa --set)"];
} else {
if (exists $default_modules->{'fa_code'}) {
$fa_code=[$default_modules->{'fa_code'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
if (exists $default_modules->{'fa_conf'}) {
$fa_conf=[$default_modules->{'fa_conf'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
if (exists $default_modules->{'fa_host'}) {
$fa_host=[$default_modules->{'fa_host'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
if (exists $default_modules->{'fa_menu'}) {
$fa_menu=[$default_modules->{'fa_menu'},
"From Default Setting ".
"(Change with fa --defaults)"];
}
}
}
}
} else {
warn("WARNING: Cannot read defaults file $fa_path/fa_global.pm".
" - permission denied (Hint: Perhaps you need to 'Run as ".
"Administrator'?)");
}
}
my @A=();my %A=();
push @A,@ARGV;
my $acnt=0;
foreach my $a (@A) {
$acnt++;
my $aa=$a;
if (-1<index $aa,'--fa_') {
my $k=unpack('x5a*',$aa);
my $v=$A[$acnt]||'';
unless (-1<index $v, '--fa_') {
$A{$k}=$v;
} else {
@A=();
last;
}
} elsif (-1<index $aa,'--set') {
my $v=$A[$acnt]||'';
unless (-1<index $v, '--') {
$A{set}=$v;
} else {
@A=();
last;
}
}
}
foreach my $e (('set','code','conf','host','menu')) {
if (exists $A{$e}) {
if ($e eq 'set') {
no strict 'subs';
my $setname=$A{$e};
my $progname=substr($0,(rindex $0,'/')+1,-3);
if (-f $fa_path.'/fa_global.pm') {
my ($stenv,$std)=
Net::FullAuto::FA_Core::connect_berkeleydb('Sets');
my $username=&Net::FullAuto::FA_Core::username();
my $set='';
my $status=$std->db_get(
$username,$set);
$set||='';
$set=~s/\$HASH\d*\s*=\s*//s
if -1<index $set,'$HASH';
$set=eval $set;
$set||={};
undef $std;
$stenv->close();
undef $stenv;
$fa_code=[$set->{$setname}->{'fa_code'},
"From CMD arg fa --set $setname line ".__LINE__];
$fa_conf=[$set->{$setname}->{'fa_conf'},
"From CMD arg fa --set $setname line ".__LINE__];
$fa_host=[$set->{$setname}->{'fa_host'},
"From CMD arg fa --set $setname line ".__LINE__];
$fa_menu=[$set->{$setname}->{'fa_menu'},
"From CMD arg fa --set $setname line ".__LINE__];
} 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";
die $die;
}
} elsif ($e eq 'code') {
$fa_code=$A{$e};
$fa_code=[$fa_code,
"From CMD arg: fa --fa_code $A{$e}"];
} elsif ($e eq 'menu') {
$fa_menu=$A{$e};
$fa_menu=[$fa_menu,
"From CMD arg: fa --fa_menu $A{$e}"];
} elsif ($e eq 'host') {
$fa_host=$A{$e};
$fa_host=[$fa_host,
"From CMD arg: fa --fa_host $A{$e}"];
} elsif ($e eq 'conf') {
$fa_conf=$A{$e};
$fa_conf=[$fa_conf,
"From CMD arg: fa --fa_conf $A{$e}"];
}
}
my $abspath=Cwd::abs_path($0);
$abspath=~s/\.exe$//;
$abspath.='.pl';
if (defined $main::fa_code && $main::fa_code) {
$fa_code=$main::fa_code;
my $p=Cwd::abs_path($0);
$fa_code=[$fa_code,
"From \$fa_code variable in $abspath"];
}
if (defined $main::fa_conf && $main::fa_conf) {
$fa_conf=$main::fa_conf;
$fa_conf=[$fa_conf,
"From \$fa_conf variable in $abspath"];
}
if (defined $main::fa_host && $main::fa_host) {
$fa_host=$main::fa_host;
$fa_host=[$fa_host,
"From \$fa_host variable in $abspath"];
}
if (defined $main::fa_menu && $main::fa_menu) {
$fa_menu=$main::fa_menu;
$fa_menu=[$fa_menu,
"From \$fa_menu variable in $abspath"];
}
}
} else {
my $abspath=Cwd::abs_path($0);
$abspath=~s/\.exe$//;
$abspath.='.pl';
$fa_code=[$fa_code,
"From \$fa_code variable in $abspath"];
$fa_conf=[$fa_conf,
"From \$fa_conf variable in $abspath"];
$fa_host=[$fa_host,
"From \$fa_host variable in $abspath"];
$fa_menu=[$fa_menu,
"From \$fa_menu variable in $abspath"];
}
$fa_code->[0]='Net/FullAuto/'.$fa_code->[0]
if $fa_code->[0] && -1==index $fa_code->[0],'Net/FullAuto';
$fa_code->[0]||='';
$fullpath_files{'code'}=$net_path.$fa_code->[0] if $fa_code->[0];
$fullpath_files{'code'}||='';
my $argv=join " ",@ARGV;
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];
my $mod=substr($fa_code->[0],(rindex $fa_code->[0],'/')+1,-3);
import $mod;
$fullpath_files{'code'}=$net_path.$fa_code->[0];
$fa_code=$mod.'.pm';
} else {
my $ln=__LINE__;
$ln-=5;
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";
}
} else {
require 'Net/FullAuto/Distro/fa_code.pm';
import fa_code;
$fullpath_files{'code'}=$net_path.'Net/FullAuto/Distro/fa_code.pm';
$fa_code='fa_code.pm';
}
}
$fa_conf->[0]='Net/FullAuto/'.$fa_conf->[0]
if $fa_conf->[0] && -1==index $fa_conf->[0],'Net/FullAuto';
$fa_conf->[0]||='';
$fullpath_files{'conf'}=$net_path.$fa_conf->[0] if $fa_conf->[0];
$fullpath_files{'conf'}||='';
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];
my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3);
import $mod;
$fullpath_files{'conf'}=$net_path.$fa_conf->[0];
$fa_conf=$mod.'.pm';
} else {
my $ln=__LINE__;
$ln-=5;
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";
}
} else {
require 'Net/FullAuto/Distro/fa_conf.pm';
import fa_conf;
$fullpath_files{'conf'}=$net_path.'Net/FullAuto/Distro/fa_conf.pm';
$fa_conf='fa_conf.pm';
}
}
$fa_host->[0]='Net/FullAuto/'.$fa_host->[0]
if $fa_host->[0] && -1==index $fa_host->[0],'Net/FullAuto';
$fa_host->[0]||='';
$fullpath_files{'host'}=$net_path.$fa_host->[0] if $fa_host->[0];
$fullpath_files{'host'}||='';
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];
my $mod=substr($fa_host->[0],(rindex $fa_host->[0],'/')+1,-3);
import $mod;
$fullpath_files{'host'}=$net_path.$fa_host->[0];
$fa_host=$mod.'.pm';
} else {
my $ln=__LINE__;
$ln-=5;
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";
}
} else {
require 'Net/FullAuto/Distro/fa_host.pm';
import fa_host;
$fullpath_files{'host'}=$net_path.'Net/FullAuto/Distro/fa_host.pm';
$fa_host='fa_host.pm';
}
}
$fa_menu->[0]='Net/FullAuto/'.$fa_menu->[0]
if $fa_menu->[0] && -1==index $fa_menu->[0],'Net/FullAuto';
$fa_menu->[0]||='';
$fullpath_files{'menu'}=$net_path.$fa_menu->[0] if $fa_menu->[0];
$fullpath_files{'menu'}||='';
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];
my $mod=substr($fa_menu->[0],(rindex $fa_menu->[0],'/')+1,-3);
import $mod;
$fullpath_files{'menu'}=$net_path.$fa_menu->[0];
$fa_menu=$mod.'.pm';
} else {
my $ln=__LINE__;
$ln-=5;
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";
}
} else {
require 'Net/FullAuto/Distro/fa_menu_demo.pm';
import fa_menu_demo;
$fullpath_files{'menu'}=$net_path.'Net/FullAuto/Distro/fa_menu_demo.pm';
$fa_menu='fa_menu_demo.pm';
}
}
return \%fullpath_files;
}
our $adminmenu=sub {
my $invoke_menu_here=0;
$Net::FullAuto::FA_Core::skip_host_hash||=0;
if ((-1==index $Net::FullAuto::FA_Core::localhost,'=')
&& ($Net::FullAuto::FA_Core::skip_host_hash==0)) {
$invoke_menu_here=1;
can_load(modules => { "Term::Menus" => 0 });
can_load(modules => { "Net::FullAuto" => 0 });
my @Hosts=@{&check_Hosts($Net::FullAuto::FA_Core::fa_host)};
&Net::FullAuto::FA_Core::host_hash(\@Hosts);
}
my $fam=<<'FAM';
_ _ _ __ __
/_\ __| |_ __ (_)_ _ | \/ |___ _ _ _ _
/ _ \/ _` | ' \| | ' \ | |\/| / -_) ' \ || |
/_/ \_\__,_|_|_|_|_|_||_| |_| |_\___|_||_\_,_|
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,
);
unless ($invoke_menu_here) {
return \%admin;
} else {
my @menu_output=();
while (1) {
@menu_output=Menu(\%admin);
last if ($menu_output[0] ne '-' && $menu_output[0] ne '+');
}
if ( grep { /\]quit\[/ } @menu_output) {
&Net::FullAuto::FA_Core::cleanup();
}
}
};
our $admin_menu=sub {
return $adminmenu->();
};
our $choose_pass_expiration=sub {
my $selection=&Menu(\%ask_exp);
&cleanup if $selection eq ']quit[';
my ($num,$type)=('','');
($num,$type)=split /\s+/, $selection;
$type||='';
if ($num!~/^\d/) {
my @d=split /,* +/, $selection;
$mn=unpack('a3',$d[0]);
if (defined $d[3] && $d[3]) {
my $ap=substr($d[3],-2);
my ($h,$m)=('','');
($h,$m)=split ':',substr($d[3],0,-2);
$h+=12 if $ap eq 'pm' && $h!=12;
return &Net::FullAuto::FA_Core::timelocal(
0,$m,$h,$d[1],$Net::FullAuto::FA_Core::month{$mn}-1,$d[2]);
}
return &Net::FullAuto::FA_Core::timelocal(
0,0,0,$d[1],$Net::FullAuto::FA_Core::month{$mn}-1,$d[2]);
} else {
return $num;
}
};
sub passwd_db_update
{
my @topcaller=caller;
print "main::passwd_db_update() CALLER="
,(join ' ',@topcaller),"\n";# if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "main::passwd_db_update() CALLER=",
(join ' ',@topcaller),"\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $hostlabel=$_[0];my $login_id=$_[1];my $passwd=$_[2];
my $cmd_type=$_[3];my $sshport=$_[4]||'';
my $kind='prod';
my $local_host_flag=0;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
if ($hostlabel eq "__Master_${$}__") {
# print the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
next if $k eq "__Master_${$}__";
$hostlabel=$k;
$local_host_flag=1;
last;
}
undef $cursor ;
if (!$local_host_flag) {
$hostlabel=$Net::FullAuto::FA_Core::local_hostname;
$local_host_flag=1;
}
} elsif (exists
$Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel}
&& !$sshport) {
$local_host_flag=1;
} my $key='';
if ($local_host_flag) {
$key="${username}_X_"
."${hostlabel}_X_${$}_X_$Net::FullAuto::FA_Core::invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_"
."${hostlabel}_X_$cmd_type";
} else {
$key="${username}_X_${login_id}_X_"
.$hostlabel;
}
my $href='';
my $status=$bdb->db_get($hostlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
foreach my $ky (keys %{$href}) {
if ($ky eq $key) {
while (delete $href->{"$key"}) {}
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $href->{"$ky"}) {}
}
}
my $cipher='';my $mr="__Master_".$$."__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
if ($Net::FullAuto::FA_Core::dcipher &&
8<length $Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
my $new_encrypted=$cipher->encrypt($passwd);
$href->{$key}=$new_encrypted;
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($hostlabel,$put_href);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
sub su_scrub
{
my $hostlabel=$_[0];my $login_id='';my $cmd_type=$_[1];
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
my $local_host_flag=0;
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %Net::FullAuto::FA_Core::same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";
$local_host_flag=1;
}
if (!$local_host_flag) {
$local_host_flag=1;
}
} elsif (exists $Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel}) {
$local_host_flag=1;
}
my $href='';
my $status=$bdb->db_get($hostlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $key='';
if ($local_host_flag) {
$key="${username}_X_"
."${hostlabel}_X_${$}_X_$Net::FullAuto::FA_Core::invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_"
."${hostlabel}_X_$cmd_type";
} else {
$key="${username}_X_${login_id}_X_"
.$hostlabel;
}
foreach my $ky (keys %{$href}) {
if ($ky eq $key) {
while (delete $href->{$key}) {}
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $href->{$ky}) {}
}
}
my $cipher='';my $mr="__Master_".$$."__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}
=~/$Net::FullAuto::FA_Core::crypt_cipher/) {
if (8<length $Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
#my $cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passwd[1],
#my $cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passetts->[1],
# $Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
#my $new_encrypted=$cipher->encrypt($Net::FullAuto::FA_Core::passwd[0]);
my $new_encrypted=$cipher->encrypt(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]));
#my $new_encrypted=$cipher->encrypt($Net::FullAuto::FA_Core::passetts->[0]);
$href->{$key}=$new_encrypted;
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($hostlabel,$put_href);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
sub su
{
my @topcaller=caller;
print "su() CALLER=", (join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "su() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $fh=$_[0];
my $hostlabel=$_[1];
my $username=$_[2];
my $su_id=$_[3];
my $hostname=$_[4];
my $ip=$_[5];
my $use=$_[6];
my $uname=$_[7];
my $_connect=$_[8];
my $cmd_type=$_[9];
my @connect_method=@{$_[10]};
my $errmsg=$_[11];
my $pass_flag=0;
my $id='';my $stderr='';my $track='';
my $cfh_ignore='';my $cfh_error='';
if ($su_id eq 'root') {
my $gids='';
my $ctt=2;
while ($ctt--) {
($gids,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ] },'groups');
if (!$gids && !$stderr) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$fh);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
} last if $gids;
}
die 'no-gids' if !$gids || $stderr;
print $Net::FullAuto::FA_Core::LOG "su() DONEGID=$gids<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (lc($uname) eq 'aix' && (-1==index $gids,'suroot')) {
my $hostlb=$hostlabel;
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";
$hostlb=$hostlab;
last;
}
}
my $die="\"$username\" does NOT have authorization to "
."run this\n script on Host : $hostlb\n"
." \"$username\" is not a member of the \"suroot\""
." UNIX group.\n Contact your system administrator.\n";
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
my $href='';
my $status=$bdb->db_get($hostlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $key="${username}_X_${su_id}_X_${hostlabel}";
while (delete $href->{$key}) {}
$status=$bdb->db_put($hostlabel,$href);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
print $Net::FullAuto::FA_Core::LOG "DYING HERE WITH LOCK PROB" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
return '',"$die $!";
}
}
#if ($su_id eq 'root') {
$fh->print("su $su_id");
#} else {
# $fh->print("login $su_id");
#}
return '', $fh->errmsg if $fh->errmsg;
# Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect });
if ($stderr) {
return '',$stderr if $stderr;
}
## Send password.
$fh->print(&getpasswd(
$hostlabel,$su_id,'',
$errmsg,'__su__'));
$fh=&Rem_Command::wait_for_prompt(
$fh,$timeout,\@connect_method,$hostlabel,'__su__');
my $cnt=2;
while (1) {
($id,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ] },
'id -unr');
if ($id eq $su_id || $id eq 'root') {
last;
} elsif ($cnt--==0) {
die "Cannot discover user id at ".__LINE__;
}
}
#($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
#&handle_error($cfh_error,'-1') if $cfh_error;
return '',$fh->errmsg if $fh->errmsg;
if ($id ne $su_id && $id ne 'root') {
$fh->print("su $su_id");
return '',$fh->errmsg if $fh->errmsg;
## Wait for password prompt.
while (my $line=$fh->get) {
$line=~tr/\0-\37\177-\377//d;
chomp($line);
if ($line=~/password[: ]*$/i) {
$pass_flag=1;last;
} elsif (!$Net::FullAuto::FA_Core::cron &&
$line=~/\[YOU HAVE NEW MAIL\]/m) {
my $hostlab=$hostlabel;
$hostlab=(keys %same_host_as_Master)[1]
if $hostlabel eq "__Master_${$}__";
print "\nAttn: $su_id on $hostlab --> [YOU HAVE NEW MAIL]\n\n";
sleep 1;
} last if $line=~/[$|%|>|#|-|:] ?$/m;
}
## Send password.
if ($pass_flag) {
$fh->print(&getpasswd(
$hostlabel,$su_id,'',$errmsg,
'__force__','__su__'));
}
($id,$stderr)=&unix_id($fh,$su_id,$hostlabel,$errmsg);
if (defined $stderr) {
return '',$stderr;
} elsif ($id ne $su_id) {
return '', "Cannot Login as Alternate User -> $su_id";
}
}
## Make sure prompt won't match anything in send data.
my $prompt = '_funkyPrompt_';
$fh->prompt("/$prompt\$/");
$fh->print(" export PS1=$prompt;unset PROMPT_COMMAND");
while (my $line=$fh->get) {
last if $line=~/$prompt$/s;
}
}
sub change_pw {
my $cmd_handle=$_[0];
print $blanklines;
## Send new passwd.
ReadMode 2;
my $npw=<STDIN>;
ReadMode 0;
PW: while (1) {
chomp($npw);
$cmd_handle->print("$npw");
my ($output,$line)='';
while ($line=$_[0]->get) {
if ($line=~/changed/) {
print $blanklines;
last PW;
}
$output.=$line;
if ($line=~/: ?$/i) {
print $output;
ReadMode 2;
$npw=<STDIN>;
ReadMode 0;
$output='';
print $blanklines;
last;
}
}
}
}
sub unix_id {
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "unix_id() CALLER=", (join ' ',@topcaller),"\n";
#if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"unix_id() CALLER=", (join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $localhost=$_[0];
my $su_id=$_[1];
my $hostlabel=$_[2];
my $die='';my $id='';
my $prompt='';my $dieline='';
eval {
my $next=0;
while (my $line=$localhost->get) {
print $Net::FullAuto::FA_Core::LOG "GETMAILLINE=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "GETMAILLINE=$line\n" if $Net::FullAuto::FA_Core::debug;
next if $line=~/^\s+$/s;
if (!$Net::FullAuto::FA_Core::cron && $line=~/\[YOU/s) {
my $hostlab=$hostlabel;
$hostlab=(keys %same_host_as_Master)[1]
if $hostlabel eq "__Master_${$}__";
print "\nAttn: $su_id on $hostlab --> [YOU HAVE NEW MAIL]\n\n";
$localhost->print;
sleep 1;
} elsif ($line=~/\d\d\d\d-\d\d\d /s) {
$dieline=__LINE__;
$die.=$line;
$localhost->print;next;
} else { $localhost->print }
last
} $localhost->print;
print $Net::FullAuto::FA_Core::LOG "OUTOFGETMAIL\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "OUTOFGETMAIL\n" if $Net::FullAuto::FA_Core::debug;
while (my $line=$localhost->get) {
print $Net::FullAuto::FA_Core::LOG "GETPROMPTLINE=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "GETPROMPTLINE=$line\n"; #if $Net::FullAuto::FA_Core::debug;
$line=~tr/\0-\11\13-\37\177-\377//d;
chomp($line);
next if $line=~/^\s*$/s;
($prompt=$line)=~s/^.*\n(.*)$/$1/s;
$prompt=~s/^\^C//;
print "WHAT IS PROMPT=$prompt<===\n";
return if $prompt;
}
};
my $cmd_prompt=quotemeta $prompt;
print $Net::FullAuto::FA_Core::LOG "PROMPT=$prompt<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "PROMPT=$prompt<==\n" if $Net::FullAuto::FA_Core::debug;
if ($die) {
$die=~s/$cmd_prompt$//s;
$die=~s/^/ /m;
$die=" $hostlabel Login ERROR! :\n$die";
$die.=" ".($!)." at Line $dieline";
}
if ($@) {
if ($die) {
return '',$die
} else {
return '',$@
}
}
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
eval {
$localhost->print(' id -unr');
select(undef,undef,undef,0.02); # sleep for 1/50th second;
while (my $line=$localhost->get) {
print $Net::FullAuto::FA_Core::LOG "ID_PROMPTLINE=$line<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$line=~tr/\0-\11\13-\37\177-\377//d;
$id.=$line;
$id=~s/id -unr\s*//s;
next if $id!~s/\s*$cmd_prompt$//s;
$id=~s/^\s*//;
last
}
};
if ($@) {
if ($die) {
return '',$die
} else {
return '',$@
}
} elsif ($die) {
if (!$id) {
return '',$die
} else {
&Net::FullAuto::FA_Core::handle_error($die,'__return__','__warn__');
return $id
}
}
#$Net::FullAuto::FA_Core::log=0 if $logreset;
return $id,''
}
sub ping
{
my @topcaller=caller;
print "ping() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "ping() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cmd='';my $stdout='';my $stderr='';my $didping=10;
if ($specialperms eq 'setuid') {
if ($^O eq 'cygwin') {
$cmd=[ $Net::FullAuto::FA_Core::gbp->('ping').
"ping",'-n','1',$_[0],"2>&1" ];
} else {
my $bashpath=$Net::FullAuto::FA_Core::gbp->('bash');
my $pth=$Hosts{"__Master_${$}__"}{'FA_Core'}."ping$$.sh";
open(TP,">$pth") || die "CANNOT OPEN $pth $!";
print TP $Net::FullAuto::FA_Core::gbp->('ping')."ping -c1 $_[0] 2>&1";
CORE::close(TP);
$cmd=[ "${bashpath}bash",$pth,"2>&1" ];
}
} else {
if ($^O eq 'cygwin') {
$cmd=[ $Net::FullAuto::FA_Core::gbp->('ping')."ping -n 1 $_[0]" ];
} else {
$cmd=[ $Net::FullAuto::FA_Core::gbp->('ping')."ping -c1 $_[0]" ];
}
}
eval {
unless ($specialperms eq 'setuid') {
($stdout,$stderr)=$localhost->cmd($cmd->[0],5);
} else {
$didping=7;
($stdout,$stderr)=&setuid_cmd($cmd,5);
}
};
my $ev_err=$@||'';
if ($specialperms eq 'setuid' && $^O ne 'cygwin') {
unlink $Hosts{"__Master_${$}__"}{'FA_Core'}."ping$$.sh";
}
if ($ev_err) {
if (wantarray) {
return 0,
$Net::FullAuto::FA_Core::gbp->('ping').
"ping timed-out: $ev_err";
} else {
&Net::FullAuto::FA_Core::handle_error(
$Net::FullAuto::FA_Core::gbp->('ping').
"ping timed-out: $ev_err","-$didping");
}
}
if (-1<index $stderr,'is alive') {
$stdout=$stderr;
$stderr='';
}
$stdout=~s/^\s*//s;
foreach my $line (split /^/, $stdout) {
$line=~tr/\0-\11\13-\37\177-\377//d;
chomp($line);
if (-1<index $line,' from ' || -1<index $line,'is alive') {
if (wantarray) {
return $stdout,'';
} else {
return $stdout;
}
}
$stderr=$stdout if (-1<index $line,'NOT FOUND')
|| (-1<index $line,'Request Timed Out')
|| (-1<index $line,'Bad IP')
|| (-1<index $line,'100% packet loss');
}
$stderr=~s/^(.*)$/ $1/mg if $stderr;
if (wantarray) {
return 0,$stderr;
} elsif (defined $_[1] && $_[1] eq '__return__') {
print $Net::FullAuto::FA_Core::LOG
"\nPING ERROR for CMD=",(join " ",@{$cmd})," AND STDERR=$stderr\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return 0;
} else {
$didping+=30;
&Net::FullAuto::FA_Core::handle_error($stderr,"-$didping");
}
}
sub work_dirs
{
my @topcaller=caller;
print "work_dirs() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "work_dirs() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $transfer_dir=$_[0];
$transfer_dir||='';
my $hostlabel=$_[1];
my $cmd_handle=$_[2];
bless $cmd_handle;
my $cmd_type=$_[3];
my $cygdrive=$_[4];
$cygdrive||='';
my $_connect=$_[5];
my ($output,$stderr,$regex)=('','','');
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transferdir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
if (-1<index $cmd_handle,'HASH') {
$regex=$cmd_handle->{_cygdrive_regex};
$cygdrive=$cmd_handle->{_cygdrive}
if exists $cmd_handle->{_cygdrive};
} elsif ($cygdrive) {
$regex=qr/^$cygdrive\//;
}
my $work_dirs={};
if ($transfer_dir) {
if (unpack('x1 a1',$transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$transfer_dir);
$path=~tr/\\/\//;
${$work_dirs}{_tmp_mswin}=$transfer_dir.'\\';
${$work_dirs}{_tmp}=$cygdrive
.'/'.lc($drive).$path.'/';
} elsif ($cygdrive && $transfer_dir=~/$regex/) {
${$work_dirs}{_tmp}=$transfer_dir.'/';
(${$work_dirs}{_tmp_mswin}=$transfer_dir)
=~s/$regex//;
${$work_dirs}{_tmp_mswin}=~s/^(.)/$1:/;
${$work_dirs}{_tmp_mswin}=~tr/\//\\/;
${$work_dirs}{_tmp_mswin}=~s/\\/\\\\/g;
${$work_dirs}{_tmp_mswin}.='\\';
} elsif ($cygdrive && unpack('a1',$transfer_dir) eq '/' ||
unpack('a1',$transfer_dir) eq '\\') {
(${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
$transfer_dir,'Transfer',
{ _cmd_handle=>$cmd_handle,_cmd_type=>$cmd_type },$hostlabel);
} elsif (unpack('a1',$transfer_dir) eq '/') {
${$work_dirs}{_tmp}=$transfer_dir.'/';
${$work_dirs}{_tmp_mswin}='';
} else {
my $die="Cannot Locate Transfer Directory - $transfer_dir";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} ${$work_dirs}{_lcd}=${$work_dirs}{_tmp_lcd}
=$localhost->{_work_dirs}->{_tmp};
${$work_dirs}{_pre_lcd}='';
return $work_dirs;
}
if (&Net::FullAuto::FA_Core::test_dir($cmd_handle,'/tmp')
eq 'WRITE') {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
${$work_dirs}{_tmp}='/tmp/';
if ($cmd_handle->{_uname} eq 'cygwin') {
my $pwd='';my $curdir='';my $cnt=5;
while ($cnt--) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&clean_filehandle($cmd_handle->{_cmd_handle});
&handle_error($cfh_error,'-1') if $cfh_error;
($pwd,$stderr)=$cmd_handle->cmd('pwd');
next if $stderr;
if ($pwd=~/\n/s) {
my @split_on_newline=split "\n", $pwd;
$pwd=pop @split_on_newline;
} next if $pwd!~/^[\/]/;
last;
}
&handle_error($stderr,'-2','__cleanup__') if $stderr;
($output,$stderr)=$cmd_handle->cmd(
"cd \"".${$work_dirs}{_tmp}."\"");
&handle_error($stderr,'-2','__cleanup__') if $stderr;
if (ref $localhost eq 'GLOB') {
($curdir,$stderr)=
&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
if ($^O eq 'cygwin') {
my $cdr='';
if (exists $localhost->{_cygdrive} &&
-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
my $cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists
$Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
${$work_dirs}{_tmp_mswin}=$cdr.'\\\\';
}
}
($output,$stderr)=$cmd_handle->cmd(
'cd '."\"$pwd\"");
&handle_error($stderr,'-2','__cleanup__') if $stderr;
} ${$work_dirs}{_lcd}=${$work_dirs}{_tmp_lcd}
=$localhost->{_work_dirs}->{_tmp} if ref $localhost eq 'GLOB';
${$work_dirs}{_pre_lcd}='';
return $work_dirs;
}
if ($cmd_handle->{_uname} eq 'cygwin') {
(${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
'temp','Temp',
$cmd_handle,$hostlabel);
if ($ms_share) {
my $host=($use eq 'ip')?$ip:$hostname;
${$work_dirs}{_cwd_mswin}="\\\\$host\\$ms_share\\";
}
return $work_dirs if ${$work_dirs}{_tmp};
} ${$work_dirs}{_tmp}=${$work_dirs}{_tmp_mswin}='';
${$work_dirs}{_lcd}=$localhost->{_work_dirs}->{_tmp};
${$work_dirs}{_pre_lcd}='';
return $work_dirs
}
sub close
{
return &File_Transfer::close(@_);
}
sub cwd
{
my @topcaller=caller;
print "\nINFO: main::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $stdout='';my $stderr='';
if (!defined $_[1]) {
return Cwd::getcwd();
} else {
($stdout,$stderr)=File_Transfer::cwd(@_);
if (wantarray) {
return $stdout,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4');
} return $stdout;
}
}
sub setuid_cmd
{
my @topcaller=caller; # Save Pound Sign
print "\nINFO: setuid_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "setuid_cmd() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*'; # 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];
my @topcaller=caller;
my $hlab='';
if ((-1<index $self,'HASH') && (exists $self->{_hostlabel})) {
$hlab=$self->{_hostlabel}->[0] || "localhost - ".hostname;
} else { $hlab="localhost - ".hostname }
print "\nINFO: main::cmd() (((((((CALLER))))))) ".
"for HostLabel $hlab:\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nmain::cmd() (((((((CALLER))))))) ".
"for HostLabel $hlab:\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $escape=0;
my $cmd='';my $cmtimeout=$timeout;my $delay=0;
if (defined $_[1] && $_[1]) {
if ($_[1]=~/^[0-9]+$/) {
$cmtimeout=$_[1];
if (-1<index $self,'HASH') {
$_[1]=$cmtimeout=$Hosts{$self->{_hostlabel}->[0]}{'Timeout'}
if exists $Hosts{$self->{_hostlabel}->[0]}{'Timeout'};
}
} elsif ($_[1] eq '__escape__') {
$escape=1;
} elsif ($_[1] eq '__delay__') {
$delay=1;
} else {
$cmd=$_[1];
}
}
if (defined $_[2] && $_[2]) {
if ($_[2]=~/^[0-9]+$/) {
$cmtimeout=$_[2];
$_[1]=$cmtimeout=$Hosts{$self->{_hostlabel}->[0]}{'Timeout'}
if exists $Hosts{$self->{_hostlabel}->[0]}{'Timeout'};
} elsif ($_[2] eq '__escape__') {
$escape=1;
} elsif ($_[2] eq '__delay__') {
$delay=1;
} else {
if ($_[2]!~/^__[a-z]+__$/) {
if (wantarray) {
return 0,'Third Argument for Timeout Value is not Whole Number';
} else {
&Net::FullAuto::FA_Core::handle_error(
'Third Argument for Timeout Value is not Whole Number')
}
}
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__escape__') {
$escape=1;
} elsif ($_[3] eq '__delay__') {
$delay=1;
}
}
my $stderr='';my $stdout='';my $exitcode='';my $pid_ts='';
my $all='';my @outlines=();my @errlines=();
if (!$escape) {
if ((-1<index $self,'HASH')
&& exists $self->{_cmd_handle}
&& defined fileno $self->{_cmd_handle}) {
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
print $Net::FullAuto::FA_Core::LOG "main::cmd() CMD to Rem_Command=",
(join ' ',@_),"\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($self->{_cmd_handle});
&handle_error($cfh_error,'__cleanup__') if $cfh_error;
sleep 1 if $delay;
eval {
($stdout,$stderr,$exitcode)=Rem_Command::cmd(@_);
};
if ($@) {
if ($stderr) {
$stderr.="\n $@";
} else {
$stderr=$@;
}
}
if (wantarray) {
return $stdout,$stderr,$exitcode;
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} else {
&handle_error($stderr,'-16');
}
} return $stdout;
#$Net::FullAuto::FA_Core::log=0 if $logreset;
}
if (defined $localhost &&
$localhost &&
(-1<index $localhost,'HASH')
&& exists $localhost->{_cmd_handle}
&& defined fileno $localhost->{_cmd_handle}) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
return `@_`,$cfh_error if $cfh_error=~/password[: ]+$/si;
&handle_error($cfh_error,'-1') if $cfh_error;
($stdout,$stderr)=$localhost->cmd(@_);
if (wantarray) {
return $stdout,$stderr;
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} else {
&handle_error($stderr,'-16');
}
} return $stdout;
}
}
if ($^O eq 'cygwin') {
if ($self!~/^cd[\t ]/) {
$cmd="$self|perl -e \'\$o=join \"\",<STDIN>;\$o=~s/^/stdout: /mg;".
"print \$o,\"__STOP--\"\' 2>&1";
}
my $cmd_handle='';my $cmd_pid='';my $next=10;
while (1) {
($cmd_handle,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
[$cmd,'','','',$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch cmd subprocess");
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cmtimeout);
$cmd_handle->telnetmode(0);
$cmd_handle->binmode(1);
my $first=0;
eval {
while (my $line=$cmd_handle->get(Timeout=>$cmtimeout)) {
$line=~tr/\0-\11\13-\37\177-\377//d;
chomp($line);
next if $line=~/^\s*$/ && !$first;
$first=1;
$all.=$line;
last if $all=~s/\n*_\s*_\s*S\s*T\s*O\s*P\s*-\s*-\s*$//s;
}
};
if ($@) {
my $kill_arg=($^O eq 'cygwin')?'f':9;
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($cmd_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;
if ($next--) {
$all='';next;
} else { &cleanup }
} else { $cmd_handle->print("\004");last }
} $cmd_handle->close;
} else {
if ($self!~/^cd[\t ]/) {
my $sedpath=$Net::FullAuto::FA_Core::gbp->('sed');
$cmd="$self | ${sedpath}sed -e \'s/^/stdout: /\' 2>&1";
}
($stdout,$stderr)=&setuid_cmd($cmd,$cmtimeout);
&handle_error($stderr,'-1') if $stderr;
}
if ($all) {
foreach my $line (split /^/, $all) {
if ($line=~s/^[\t ]*stdout: //) {
push @outlines, $line;
} else { push @errlines, $line }
} $stdout=join '', @outlines;$stderr=join '',@errlines;
}
$stderr=~s/^\s*$//s;
if (wantarray) {
return $stdout,$stderr;
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} else {
&handle_error($stderr,'-16');
}
} return $stdout;
}
sub tmp
{
my @topcaller=caller;
print "PARENTTMPCALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "PARENTTMPCALLER=",
(join ' ',@topcaller), "\nand ARGS=@_\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return File_Transfer::tmp(@_);
}
sub print
{
my @topcaller=caller;
print "PARENTPRINTCALLER=",(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "PARENTPRINTCALLER=",(join ' ',@topcaller),
"\nand ARGS=@_\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
return Net::Telnet::print(@_);
}
sub scrub_passwd_file
{
my @topcaller=caller;
my $track='';
print "scrub_passwd_file() CALLER=",(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "scrub_passwd_file() CALLER=",
(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $passlabel=$_[0];my $login_id=$_[1];
my $cmd_type=$_[2];
my @passlabels=();
my $local_host_flag=0;
if ($passlabel eq "__Master_${$}__") {
my $local_host_flag=0;
foreach my $passlab (keys %same_host_as_Master) {
next if $passlab eq "__Master_${$}__";
push @passlabels, $passlab;
$local_host_flag=1;
}
if (!$local_host_flag) {
$passlabels[0]=$Net::FullAuto::FA_Core::local_hostname;
$local_host_flag=1;
}
} else {
$passlabels[0]=$passlabel;
}
foreach my $passlabel (@passlabels) {
my $key='';
if ($local_host_flag) {
$key="${username}_X_${passlabel}_X_${$}_X_$invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${passlabel}_X_${cmd_type}";
} else {
$key="${username}_X_${login_id}_X_${passlabel}";
}
print $Net::FullAuto::FA_Core::LOG "SCRUBBINGTHISKEY=$key<==\n"
if -1<index $Net::FullAuto::FA_Core::LOG,'*';
return unless exists $Hosts{"__Master_${$}__"}{'berkeley_db_path'};
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Passwds');
my $href='';
my $status=$bdb->db_get($passlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $successflag=0;
foreach my $ky (keys %{$href}) {
if ($ky eq $key) {
while (delete $href->{$key}) {}
$successflag=1;
} elsif ($ky=~/gatekeep_$username/) {
while (delete $href->{$ky}) {}
$successflag=1;
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $href->{$ky}) {}
$successflag=1;
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($passlabel,$put_href);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return $successflag;
}
}
1;
package File_Transfer;
use Time::Local;
use BerkeleyDB;
sub new {
return eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $Net::FullAuto::FA_Core::timeout;
my @topcaller=caller;
print "\nINFO: File_Transfer::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nFile_Transfer::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
our $timeout=$Net::FullAuto::FA_Core::timeout;
our $test=$Net::FullAuto::FA_Core::test;
my $class = ref($_[0]) || $_[0];
my $hostlabel=$_[1];
my $new_master=$_[2]||'';
my $_connect=$_[3]||'';
my $cache=$_[4]||$main::cache||'';
my $quiet=$_[5]||0;
my $self = { };
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my $host=($use eq 'ip') ? $ip : $hostname;
my $chk_id='';
if ($su_id) { $chk_id=$su_id }
elsif ($login_id) { $chk_id=$login_id }
else { $chk_id=&Net::FullAuto::FA_Core::username(); }
if (!$new_master &&
exists $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"}) {
if ($ping) {
if (&Net::FullAuto::FA_Core::ping($host,'__return__')) {
return $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"},'';
} else {
delete $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"};
}
} else {
return $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"},'';
}
}
my ($ftp_handle,$ftp_pid,$work_dirs,$homedir,$ftr_cmd,$ftm_type,
$cmd_type,$fpx_handle,$fpx_pid,$stderr)=
ftm_login($hostlabel,$new_master,$_connect,$cache,$quiet);
if ($stderr) {
$stderr=~s/(at .*)$/\n\n $1/s;
my $die="\n FATAL ERROR! - $stderr";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $ftp_handle,$die;
}
$self->{_hostlabel}=[ $hostlabel,'' ];
if ($ftr_cmd) {
$self->{_cmd_handle}=$ftr_cmd->{_cmd_handle};
$self->{_sh_pid}=$ftr_cmd->{_sh_pid};
$self->{_cmd_pid}=$ftr_cmd->{_cmd_pid};
$self->{_uname}=$ftr_cmd->{_uname};
$self->{_luname}=$ftr_cmd->{_luname};
$self->{_cmd_type}=$cmd_type;
if ($ftr_cmd->{_cygdrive}) {
$self->{_cygdrive}=$ftr_cmd->{_cygdrive};
$self->{_cygdrive_regex}=$ftr_cmd->{_cygdrive_regex};
}
} else {
$self->{_uname}=$uname;
$self->{_luname}=$^O;
if (-1==$#{$cmd_cnct}) {
$self->{_cmd_handle}=$ftp_handle;
$self->{_cmd_type}=$ftm_type;
} else {
$self->{_cmd_handle}='';
$self->{_cmd_type}='';
}
}
$self->{_ftp_handle}=$ftp_handle;
$self->{_fpx_handle}=$fpx_handle
if $self->{_fpx_handle};
$self->{_hostname}=$hostname;
$self->{_ip}=$ip;
$self->{_connect}=$_connect;
$self->{_ftp_type}=$ftm_type;
$self->{_work_dirs}=$work_dirs;
$self->{_ftp_pid}=$ftp_pid if $ftp_pid;
$self->{_fpx_pid}=$fpx_pid if $fpx_pid;
$self->{_homedir}=$homedir.'/';
$self->{_proxy}=$proxy;
$self->{_identityfile}=$identityfile;
bless($self,$class);
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$chk_id"}=$self;
return $self,'';
};
if (-1<index $@,'alarm') {
&Net::FullAuto::FA_Core::handle_error(
"alarm timeout at Line: ".__LINE__."\n",'-1','__cleanup__');
}
alarm(0);
}
sub handle_error
{
my @topcaller=caller;
print "File_Transfer::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::handle_error() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return &Net::FullAuto::FA_Core::handle_error(@_);
}
sub close
{
my $self=$_[0];
if (exists $self->{_ftp_handle} &&
defined fileno $self->{_ftp_handle}) {
my $ftp_handle=$self->{_ftp_handle};
my $count=0;
eval {
SC: while (defined fileno $self->{_ftp_handle}) {
$self->{_ftp_handle}->print("\004");
while (my $line=$self->{_ftp_handle}->get) {
last if $line=~/_funkyPrompt_$|
Connection.*closed|logout|221\sGoodbye/sx;
if ($line=~/^\s*$/s) {
last SC if $count++==20;
} else { $count=0 }
$self->{_ftp_handle}->print("\004");
}
}
};
eval { $self->{_ftp_handle}->close };
my $kill_arg=($^O eq 'cygwin')?'f':9;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$self->{_ftp_pid},$kill_arg)
if &Net::FullAuto::FA_Core::testpid($self->{_ftp_pid});
foreach my $h_id (keys %Net::FullAuto::FA_Core::Connections) {
if ($self eq $Net::FullAuto::FA_Core::Connections{$h_id}) {
delete $Net::FullAuto::FA_Core::Connections{$h_id};
last;
}
}
}
}
sub clean_filehandle
{
return &Net::FullAuto::FA_Core::clean_filehandle(@_);
}
sub get_vlabel
{
print "GET_VLABEL_CALLER=",caller,"\n";<STDIN>;
my ($self,$deploy_type,$dest_hostlabel,
$base_hostlabel,$archivedir) = @_;
my ($archive_hostlabel,$version_label,$label1,$label2)='';
my @output=();
if ($deploy_type eq 'get') {
$archive_hostlabel=$dest_hostlabel;
} else {
$archive_hostlabel=$base_hostlabel;
}
while ($Net::FullAuto::FA_Core::version_label eq '') {
print $Net::FullAuto::FA_Core::blanklines;
print "\n\n Please Type the Version Number of the\n";
print " Build being Deployed TO Host \"$dest_hostlabel\"\n";
print " FROM Host \"$base_hostlabel\" : ";
$label1=<STDIN>;chomp($label1);
next if $label1 eq '';
if ($label1 ne uc($label1)) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n\n ERROR! - Use Only Upper Case Letters ",
"for Version Labels!";
next;
}
print "\n Please Re-Enter the Version Number : ";
$label2=<STDIN>;chomp($label2);
if ($label1 eq "") {
print $Net::FullAuto::FA_Core::blanklines;
next;
}
if ($label1 eq $label2) {
if (($deploy_type eq 'get' || ($deploy_type eq 'put' &&
($dest_hostlabel ne "__Master_${$}__" &&
$base_hostlabel ne "__Master_${$}__")))
&& $archivedir) {
my $chmod='';my $own='';my $grp='';
my %settings=();
if (($archive_hostlabel eq "__Master_${$}__"
&& $Net::FullAuto::FA_Core::local_hostname eq substr(
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'HostName'},0,index
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'HostName'},
'.')) || $deploy_type eq 'put') {
if (defined $archivedir && $archivedir ne '') {
if (-1<index $archivedir,'__VLABEL__') {
$archivedir=~s/__VLABEL__/$label1/g;
}
if (-d "$archivedir") {
if (-f "$archivedir/mving.flg") {
$version_label=$label1;last;
} else {
my $target=$archive_hostlabel;
my $die="\n\nFATAL ERROR!!!\n\nThis Version "
."- $label1 - already exists on $target"
."!\n\nIf this is the right Version, "
."move or delete the\ndirectory on $target "
."before running this script\n\n";
&Net::FullAuto::FA_Core::handle_error(
$die,'__cleanup__');
}
} elsif ($^O ne 'cygwin' && $^O ne 'MSWin32'
&& $^O ne 'MSWin64'
&& $ENV{OS} ne 'Windows_NT') {
#### DO ERROR TRAPPING!!!!!!!!!!!!
#print "MKDIR1=$archivedir\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
$Net::FullAuto::FA_Core::gbp->('mkdir')."mkdir \'/$archivedir\'");
my $chmod=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Chmod'};
my $own=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Owner'};
my $grp=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Group'};
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chmod -v \"$chmod\" \'/$archivedir\'")
if $chmod;
@output=$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chown \"$own\" \'/$archivedir\'")
if $own;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chgrp \"$grp\" \'/$archivedir\'")
if $grp;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"touch \"/$archivedir/mving.flg\"");
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chmod -v \"$chmod\" \"/$archivedir/mving.flg\"")
if $chmod;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chown \"$own\" \"/$archivedir/mving.flg\"")
if $own;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chgrp \"$grp\" \"/$archivedir/mving.flg\"")
if $grp;
$version_label=$label1;last;
} elsif ($^O eq 'cygwin' || $^O eq 'MSWin32' || $^O eq 'MSWin64'
|| $ENV{OS} eq 'Windows_NT') {
print "DO MORE WORK ON MSWIN!\n";<STDIN>;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"mkdir -m 777 $label1");
$version_label=$label1;last;
}
}
} else { $version_label=$label1;last }
} else { $version_label=$label1;last }
} else {
print $Net::FullAuto::FA_Core::blanklines;
print "\n\n Version Numbers Do NOT Match!";
}
} print "\n\n";
$Net::FullAuto::FA_Core::version_label=$version_label;
return $version_label;
}
sub select_dir
{
#print "SELECT_DIRCALLER=",caller,"\n";
my $self=$_[0];
my $dir='.';my $random=0;
my $dots=0;my $dot=0;my $dotdot=0;
if (defined $_[1] && $_[1]) {
if ($_[1] eq '__random__') {
$random=1;
} elsif ($_[1] eq '__dots__') {
$dots=1;
} elsif ($_[1] eq '__dot__') {
$dot=1;
} elsif ($_[1] eq '__dotdot__') {
$dotdot=1;
} else {
$dir=$_[1];
}
}
if (defined $_[2] && $_[2]) {
if ($_[2] eq '__random__') {
$random=1;
} elsif ($_[2] eq '__dots__') {
$dots=1;
} elsif ($_[2] eq '__dot__') {
$dot=1;
} elsif ($_[2] eq '__dotdot__') {
$dotdot=1;
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__random__') {
$random=1;
} elsif ($_[1] eq '__dots__') {
$dots=1;
} elsif ($_[1] eq '__dot__') {
$dot=1;
} elsif ($_[1] eq '__dotdot__') {
$dotdot=1;
}
}
my $caller=(caller)[2];
my $hostlabel=$self->{_hostlabel}->[0];
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,'');
my $host= ($use eq 'ip') ? $ip : $hostname;
$ms_share||='';my %output=();my $nt5=0;
my $output='';my $stderr='';my $i=0;my @output=();
if ($ms_share || $self->{_uname} eq 'cygwin') {
my $test_chr1='';my $test_chr2='';
if ($dir) {
$test_chr1=unpack('a1',$dir);
if (1<length $dir) {
$test_chr2=unpack('a2',$dir);
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
if ($dir=~s/^$self->{_cygdrive_regex}//) {
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} elsif ($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') {
$dir=&File_Transfer::get_drive($dir,'Destination',
'',$hostlabel);
$dir=~s/^$self->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} else {
$dir=~tr/\//\\/;
$dir="\\\\$host\\$ms_share\\"
. unpack('x1 a*',$dir);
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\' || $test_chr2=~/^[a-zA-Z]:$/) {
} elsif ($test_chr1!~/\W/) {
if ($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') {
#my $curdir=&attempt_cmd_xtimes($self,
# 'cmd /c chdir',$hostlabel);
my $curdir='';
($curdir,$stderr)=
&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
my $cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$dir="$cdr\\$dir";
} else {
$dir="\\\\$host\\$ms_share\\$dir";
}
} else {
&Net::FullAuto::FA_Core::handle_error(
"Destination Directory (1) - $dir CANNOT Be Located");
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
if (($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') ||
$self->{_work_dirs}->{_cwd}=~/$self->{_cygdrive_regex}/) {
$dir=&File_Transfer::get_drive('/','Destination',
'',$hostlabel);
$dir=~s/^$self->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} else {
$dir="\\\\$host\\$ms_share";
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
$dir=$test_chr1 . ':/';
} else {
&Net::FullAuto::FA_Core::handle_error(
"Destination Directory (2) - $dir CANNOT Be Located");
} $dir=~tr/\\/\//;$dir=~tr/\//\\/;$dir=~s/\\/\\\\/g;my $cnt=0;
} else {
if (($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') ||
$self->{_work_dirs}->{_cwd}=~/^$self->{_cygdrive_regex}/) {
$dir=&File_Transfer::get_drive('/','Destination','',$hostlabel);
$dir=~s/^$self->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} else {
$dir="\\\\$host\\$ms_share";
}
}
my $cnt=0;
while (1) {
($output,$stderr)=$self->cmd("cmd /c dir /-C \"$dir\"");
if (!$stderr && $output!~/bytes free\s*$/s) {
prin $Net::FullAuto::FA_Core::LOG "sub select_dir Rem_Command::cmd() BAD output=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
unless ($cnt++) { $output='';next }
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$dir\"\n"
."\n run on the host $self->{_hostlabel}->[0] FAILED"
."\n\n BAD OUTPUT==>$output\n";
&Net::FullAuto::FA_Core::handle_error($die,'-6');
} else { last }
}
if (!$stderr) {
$output=~s/^.*Directory of (.*)$/$1/s;
my $mn=0;my $dy=0;my $yr=0;
my $hr=0;my $mt='';my $pm='';my $size='';
my $file='';my $filetime=0;my $cnt=0;
foreach my $line (split /^/, $output) {
next if $cnt++<4;
next if -1==index $line,'<DIR>';
$line=~tr/\0-\37\177-\377//d;
chomp($line);
if (39<length $line) {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,"$line");
$nt5=1;
} else {
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,"$line");
}
$filetime=timelocal(
0,$mt,$Net::FullAuto::FA_Core::hours{$hr.$pm},$dy,$mn-1,$yr);
} push @{$output{$filetime}},
{$file=>"$mn/$dy/$yr $hr:$mt$pm"};
}
foreach my $filetime (reverse sort keys %output) {
foreach my $filehash (@{$output{$filetime}}) {
foreach my $file (reverse sort keys %{$filehash}) {
push @output,${$filehash}{$file}." $file";
}
}
}
}
} else {
($output,$stderr)=$self->cmd("ls -lt $dir");
if (!$stderr) {
my $lchar_flag=0;
foreach my $line (split /\n/, $output) {
next if unpack('a5',$line) eq 'total';
my $lchar=substr($line,-1);
if ($lchar eq '*' || $lchar eq '/' || $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$lchar_flag=1;
}
chop $line;
}
my $endofline=substr($line,-2);
if ($endofline eq '..' && !$dots && !$dotdot) { next }
if ($endofline eq ' .' && !$dots && !$dot) { next }
my $date=substr($line,41,13);
my $file=unpack('x54 a*',$line);
push @output,"$date $file";
}
}
} my $die='';
if ($stderr) {
my $caller=(caller(1))[3];
substr($caller,0,(index $caller,'::')+2)='';
my $sub='';
if ($caller eq 'connect_ftp'
|| $caller eq 'connect_telnet') {
($caller,$sub)=split '::', (caller(2))[3];
$caller.='.pm';
} else {
my @called=caller(2);
if ($caller eq 'mirror' || $caller eq 'login_retry') {
$sub=$called[3]
} else {
$caller=$called[3];
$called[6]||='';
$sub=($called[6])?$called[6]:$called[3];
} $sub=~s/\s*\;\n*//
}
my $mod='';($mod,$sub)=split '::', $sub;
$stderr=~s/\sat\s${progname}\s/\n at ${progname} /;
$die="Cannot change to directory:\n\n"
." \"$dir\"\n\n in the \"&select_dir()\" "
."Subroutine (or Method)\n Called from the "
."User Defined Subroutine\n -> $sub\n "
."in the \"subs\" Subroutine File -> "."${mod}.pm\n\n"
." The Remote System $host Returned\n "
."the Following Error Message:\n\n $stderr";
} elsif ($random) {
$output=$output[rand $#output];
chomp $output;
if ($ms_share) {
if ($nt5) {
substr($output,0,19)="";
} else {
substr($output,0,21)="";
}
} else { substr($output,0,16)="" }
$output=~s/\s*$//;
} else {
my $banner="\n Please Pick a Directory :";
$output=&Menus::pick(\@output,$banner);
chomp $output;
if ($output ne ']quit[') {
if ($ms_share) {
if ($nt5) {
substr($output,0,19)="";
} else {
substr($output,0,21)="";
}
} else { substr($output,0,16)="" }
} else { &Net::FullAuto::FA_Core::cleanup() }
$output=~s/\s*$//;
}
if (wantarray) {
return $output,$die;
} elsif ($stderr) {
&Net::FullAuto::FA_Core::handle_error($die);
} else { return $output }
}
sub testfile
{
#print "TESTFILE_CALLER=",caller,"\n";
my ($self, @args) = @_;
my @output=();
my $output="";
eval {
$output=$self->cmd("ls -l @args");
print "OBJECT=$output\n";<STDIN>;
}
}
sub sftp
{
my @topcaller=caller;
print "File_Transfer::sftp() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::sftp() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self = shift @_;
if (exists $self->{_ftp_handle}) {
return $self->{_ftp_handle}->cmd(@_);
} else {
my $error="Not logged in via (s)ftp\n";
&Net::FullAuto::FA_Core::handle_error($error);
}
}
sub ftp
{
my @topcaller=caller;
print "File_Transfer::ftp() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::ftp() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self = shift @_;
if (exists $self->{_ftp_handle}) {
return $self->{_ftp_handle}->cmd(@_);
} else {
my $error="Not logged in via (s)ftp\n";
&Net::FullAuto::FA_Core::handle_error($error);
}
}
sub ftpcmd
{
my @topcaller=caller;
print "File_Transfer::ftpcmd() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::ftpcmd() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self = shift @_;
if (exists $self->{_ftp_handle}) {
return $self->{_ftp_handle}->cmd(@_);
} else {
my $error="Not logged in via (s)ftp\n";
&Net::FullAuto::FA_Core::handle_error($error);
}
}
sub sftpcmd
{
my @topcaller=caller;
print "File_Transfer::sftpcmd() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::sftpcmd() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self = shift @_;
if (exists $self->{_ftp_handle}) {
return $self->{_ftp_handle}->cmd(@_);
} else {
my $error="Not logged in via (s)ftp\n";
&Net::FullAuto::FA_Core::handle_error($error);
}
}
sub cmd
{
my @topcaller=caller;
print "\nINFO: File_Transfer::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nFile_Transfer::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $command='';my $cache='';
my ($self,@args) = @_;
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;
}
$cache||='';
$command=$args[0];
my @output=();my $cmdlin=0;
my $output='';my $stderr='';
eval {
if (ref $self eq 'File_Transfer' && (!exists $self->{_cmd_handle}
|| $self->{_cmd_handle} ne "__Master_${$}__")) {
if ((($self->{_cmd_type} eq 'telnet' ||
$self->{_cmd_type} eq 'ssh') && unpack('a1',$command) ne '!')) {
$cmdlin=29;
($output,$stderr)=Rem_Command::cmd($self,@args,$cache);
} elsif ($self->{_ftp_type} eq 'ftp' ||
$self->{_ftp_type} eq 'sftp') {
($output,$stderr)=&Rem_Command::ftpcmd($self,$command,$cache);
$cmdlin=26;
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_cmd_type} .
" protocol not supported for command interface: ");
}
} else {
$cmdlin=9;
($output,$stderr)=&Net::FullAuto::FA_Core::cmd($command);
}
};
if (wantarray) {
return $output,$stderr;
} elsif ($stderr) {
&Net::FullAuto::FA_Core::handle_error($stderr,-$cmdlin) if $stderr;
} else { return $output }
}
sub ls
{
my @topcaller=caller;
print "File_Transfer::ls() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::ls() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($self, $options, $path, $cache) = @_;
$path='' unless defined $path;
$options='' unless defined $options;
my $output='';my $stderr='';
if ($path && unpack('a1',$path) eq '"') {
$path=unpack('a1 a*',$path);
substr($path,-1)='';
}
if ($path) {
($output,$stderr)=&Rem_Command::ftpcmd($self,"ls \"$path\"",$cache);
} else {
($output,$stderr)=&Rem_Command::ftpcmd($self,'ls',$cache);
}
my $newout='';
if ($options eq '1' || $options eq '-1') {
foreach my $line (split /^/, $output) {
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;
if ($line=~s/^.*\s+($rx1|$rx2)$/$1/) {
$line=~
s/^\d+\s+\w\w\w\s+\d+\s+(?:\d\d:\d\d\s+|\d\d\d\d\s+)(.*)$/$1/;
$newout.=$line;
}
} $output=$newout if $newout;
}
return '',$stderr if $stderr;
$output=~tr/\0-\11\13-\37\177-\377//d;
chomp($output);
$output=~s/^\s+//;
return $output,'';
}
sub lcd
{
my @topcaller=caller;
print "File_Transfer::lcd() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::lcd() CALLER=",
(join ' ',@topcaller),
"\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
#"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($self, $path, $cache) = @_;
$cache||='';
my $output='';my $stdout='';my $stderr='';
if (unpack('a1',$path) eq '"') {
$path=unpack('a1 a*',$path);
substr($path,-1)='';
}
$self->{_work_dirs}->{_pre_lcd}=$self->{_work_dirs}->{_lcd};
$path=~s/\\/\\\\/g;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::lcd() PATH=$path<==\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
($output,$stderr)=&Rem_Command::ftpcmd($self,"lcd \"$path\"",$cache);
if ($self->{_ftp_type} eq 'sftp') {
($stdout,$stderr)=&Rem_Command::ftpcmd($self,"lpwd",$cache);
$self->{_work_dirs}->{_lcd}=$stdout;
} else {
$self->{_work_dirs}->{_lcd}=$path;
}
return '',$stderr if $stderr;
return $output,'';
}
sub get
{
my @topcaller=caller;
print "File_Transfer::get() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::get() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cache='';my $display=0;
my ($self, @args) = @_;
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;
} elsif (grep { /__display__/ } @args) {
$display=1;
}
my $output='';my $stderr='';
my $path='';my $file='';
foreach my $file_arg (@args) {
if ($self->{_ftp_type} eq 'ftp') {
if (-1<index $file_arg,'/') {
$path=substr($file_arg,0,(rindex $file_arg,'/'));
$file=substr($file_arg,(rindex $file_arg,'/')+1);
$path=~s/^~/$self->{_home_dir}/;
($output,$stderr)=&Rem_Command::ftpcmd($self,
"cd \"$path\"",$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
}
} elsif (-1<index $file_arg,'\\') {
$path=substr($file_arg,0,(rindex $file_arg,'\\'));
$file=substr($file_arg,(rindex $file_arg,'\\')+1);
$path=~s/^~/$self->{_home_dir}/;
($output,$stderr)=&Rem_Command::ftpcmd($self,
"cd \"$path\"",$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
}
} else { $file=$file_arg }
} else { $file=$file_arg }
unless (&Net::FullAuto::FA_Core::acquire_fa_lock($file_arg)) {
return 'SEMAPHORE','' if wantarray;
return 'SEMAPHORE';
}
$file=~s/^["']+(.*)["']+$/$1/;
($output,$stderr)=&Rem_Command::ftpcmd($self,
"get \"$file\"",$cache);
&Net::FullAuto::FA_Core::release_fa_lock($file_arg);
if ($stderr) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "GET ERROR! - $stderr\n";
}
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
} elsif (wantarray) {
return $output,'';
} else {
return $output;
}
} return $output,'' if wantarray;
return $output;
}
sub put
{
my @topcaller=caller;
print "File_Transfer::put() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::put() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cache='';my $display=0;
my ($self, @args) = @_;
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;
} elsif (grep { /__display__/ } @args) {
$display='__display__';
}
my ($output,$stderr)='';
foreach my $file (@args) {
$file=~s/^~/$self->{_home_dir}/;
$file=~s/^["']+(.*)["']+$/$1/;
if ($file eq '*') {
($output,$stderr)=&Rem_Command::ftpcmd($self,
"put *",$cache,$display);
} else {
($output,$stderr)=&Rem_Command::ftpcmd($self,
"put \"$file\"",$cache,$display);
}
if ($stderr) {
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "PUT ERROR! - $stderr\n";
}
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
} elsif (wantarray) {
return $output,'';
} else {
return $output;
}
}
}
sub size
{
my @topcaller=caller;
print "File_Transfer::size() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::size() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cache='';
my ($self, @args) = @_;
if (-1<index $args[$#args],'Cache::FileCache') {
$cache=pop @args;
} elsif ((-1<index $args[$#args],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($args[$#args]->chi_root_class)) {
$cache=pop @args;
}
my ($output,$stderr)='';
foreach my $file (@args) {
if ($self->{_ftp_handle} ne "__Master_${$}__") {
$file=~s/^["']+(.*)["']+$/$1/;
($output,$stderr)=&Rem_Command::ftpcmd($self,
"get \"$file\"",$cache);
} else {
$output=(stat("$file"))[7] || ($stderr=
"cannot stat and obtain file size for $file\n $!");
}
if ($stderr) {
print "ERROR! - $stderr\n";
}
}
}
sub ftr_cmd
{
my @topcaller=caller;
print "File_Transfer::ftr_cmd() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "File_Transfer::ftr_cmd() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $hostlabel=$_[0];
my $ftp_handle=$_[1];
my $new_master=$_[2]||'';
my $_connect=$_[3]||'';
my $cache=$_[4]||'';
our $track='';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$frtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my $host= ($use eq 'ip') ? $ip : $hostname;
$ms_share='' unless defined $ms_share;
$ms_domain='' unless defined $ms_domain;
$login_id=&Net::FullAuto::FA_Core::username() if !defined $su_id;
my $work_dirs={};my $ftr_cmd='';my $ms_su_id='';my $ms_login_id='';
my $ms_hostlabel='';my $ms_host='';my $ms_ms_share='';
my $local_transfer_dir='';my $cmd_type='';my $ms_ms_domain='';
my $output='';my $stderr='';my $ms_transfer_dir='';
my @output=();my $cw1='';my $cw2='';my $ftm_type='';
foreach my $cnct (@{$cmd_cnct}) {
$cmd_type=lc($cnct);
if (($cmd_type eq 'telnet' || $cmd_type eq 'ssh')) {
($ftr_cmd,$stderr)=
Rem_Command::new('Rem_Command',$hostlabel,
$new_master,$_connect);
if ($stderr) {
chomp $stderr;
return '','','','',$stderr;
}
$cmd_type=$ftr_cmd->{_cmd_type};
$ftr_cmd->{_ftp_handle}=$ftp_handle;
if (defined $transfer_dir && $transfer_dir) {
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftr_cmd,$cmd_type,'',$_connect);
my $curdir='';
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($ftr_cmd,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$ftr_cmd,"cygpath -w \"$curdir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
${$work_dirs}{_pre_mswin}=$cdr.'\\\\';
$ftr_cmd->{_cygdrive}||='/';
$work_dirs->{_pre}=$curdir.'/';
($output,$stderr)=$ftr_cmd->cmd('cd '.$work_dirs->{_tmp});
if ($stderr) {
@FA_Core::tran=();
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die,'-5');
}
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
$output=join '',
$ftr_cmd->{_ftp_handle}->cmd('cd '.$work_dirs->{_tmp});
if ($output=~/^(5.*)$/m) {
my $line=$1;
$line=~tr/\0-\37\177-\377//d;
chomp($line);
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $line";
&Net::FullAuto::FA_Core::handle_error($die,'-7');
}
$work_dirs->{_cwd}=$work_dirs->{_tmp};
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin};
$Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;
$Net::FullAuto::FA_Core::ftpcwd{$ftr_cmd->{_ftp_handle}}{cd}
=${$work_dirs}{_tmp};
} else {
my $curdir='';
if ($ftr_cmd->{_uname} eq 'cygwin') {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
if ($^O eq 'cygwin') {
my $cdr='';
if (exists $localhost->{_cygdrive} &&
-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
my $cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$curdir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
}
$work_dirs->{_pre_mswin}=
$work_dirs->{_cwd_mswin}=$cdr.'\\\\';
$work_dirs->{_tmp_mswin}=
$ftr_cmd->{_work_dirs}->{_tmp_mswin};
}
$work_dirs->{_pre}=$work_dirs->{_cwd}=$curdir.'/';
$work_dirs->{_tmp}=$ftr_cmd->{_work_dirs}->{_tmp};
$Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;
} else {
my $cnt=3;
while ($cnt--) {
($curdir,$stderr)=$ftr_cmd->cmd('pwd');
if (!$curdir) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
} else {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
last
}
}
$curdir.='/' if $curdir ne '/';
$work_dirs->{_pre}=$work_dirs->{_cwd}=$curdir.'/';
$work_dirs->{_tmp}=$ftr_cmd->{_work_dirs}->{_tmp};
$Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;
}
} return $work_dirs,$ftr_cmd,$cmd_type,$ftm_type,'' if $ftr_cmd;
}
}
return $work_dirs,$ftr_cmd,$cmd_type,$ftm_type,'';
}
sub ftm_login
{
my @topcaller=caller;
print "\nINFO: File_Transfer::ftm_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nFile_Transfer::ftm_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $hostlabel=$_[0];
my $new_master=$_[1]||'';
my $_connect=$_[2]||'';
my $cache=$_[3]||'';
my $quiet=$_[4]||'';
my $homedir='';
my $kill_arg=($^O eq 'cygwin')?'f':9;
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my @connect_method=@{$ftr_cnct};
my $host=($use eq 'ip') ? $ip : $hostname;
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;
}
print $Net::FullAuto::FA_Core::LOG "NEWMASTER=$new_master<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$new_master && ($hostlabel eq "__Master_${$}__"
|| exists $Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel})) {
return "__Master_${$}__",'','','','','','','','';
}
my $ftp_handle='';my $ftr_cmd='';my $su_login='';
my $ftm_errmsg='';my $die='';my $s_err='';my $shell_pid=0;
my $retrys=0;my $local_transfer_dir='';my $cmd_type='';
my $ms_host='';my $ms_hostlabel='';my $fpx_handle='';
my $work_dirs={};my $die_login_id='';my $ftm_only=0;
my $ms_su_id='';my $ms_login_id='';
my $ms_ms_domain='';my $ms_ms_share='';my $ftm_type='';
my $desthostlabel='';my $p_uname='',my $fpx_passwd='';
my $ftm_passwd=$Net::FullAuto::FA_Core::dcipher->decrypt(
$Net::FullAuto::FA_Core::passetts->[0]) if
$Net::FullAuto::FA_Core::dcipher;
$ftm_passwd||='';
my $ftp_pid='';my $fpx_pid='';
my @errorstack=();
my ($output,$stdout,$stderr)=('','','');
$login_id=&Net::FullAuto::FA_Core::username() if !$login_id;
while (1) {
eval {
#############################################################
# ONE-TO-ONE-CONNECTION LOGIN BEGINS HERE
#############################################################
foreach my $connect_method (@connect_method) {
if (lc($connect_method) eq 'ftp') {
$ftm_type='ftp';last;
} elsif (lc($connect_method) eq 'sftp') {
$ftm_type='sftp';last;
}
}
if ($ftm_type eq 'ftp' ||
!(exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'} &&
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'})) {
$determine_password->('',0,$hostlabel,$password);
unless ($password) {
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$su_id,'',$ftm_errmsg,'__su__',$ftm_type);
if ($ftm_passwd ne 'DoNotSU!') {
$su_login=1;
} else { $su_id='' }
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$login_id,'',$ftm_errmsg,$ftm_type);
}
} else {
$ftm_passwd=$password;
}
}
if ($spawn ne 'bash') {
my $looped=0;
while ($looped++<2) {
($ftp_handle,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master,$_connect,'',$looped);
$stderr=$@ if $@;
if ($stderr) {
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nhhhhhhh Error getting \$ftp_handle ",
"via Rem_Command::cmd() hhhhhhh: ",
"==>$stderr<==\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
} else { last }
}
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1','__cleanup__') if $stderr;
$ftp_pid=$ftp_handle->{_cmd_pid};
$shell_pid=$ftp_handle->{_sh_pid};
$cmd_type=$ftp_handle->{_cmd_type};
$ftp_handle=$ftp_handle->{_cmd_handle};
$ftp_handle->timeout($fttimeout);
}
my $previous_method='';$stderr='';
my $fm_cnt=-1;my $key_authentication=0;
CM2: foreach my $connect_method (@connect_method) {
$fm_cnt++;
if ($stderr && $connect_method ne $previous_method) {
print "Warning (3), Preferred Connection ",
"$previous_method Failed\n"
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet);
print "\n".$stderr."\n"
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet);
} else { $previous_method=$connect_method;$stderr='' }
if (lc($connect_method) eq 'ftp') {
if ($spawn eq 'bash') {
($ftp_handle,$ftp_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',$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");
$ftp_handle=Net::Telnet->new(Fhopen => $ftp_handle,
Timeout => $timeout);
}
my $ftp__cmd=$Net::FullAuto::FA_Core::gbp->('ftp')."ftp $host";
$ftp_handle->print(' '.$ftp__cmd);
FH: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys
%{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftp_handle eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete $Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type}=
$value;
last FH;
}
}
}
}
## Send Login ID.
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (2)
print "\n Logging into $host ($hostl) via ",
"$connect_method . . .\n\n";
$cache->set($cache->{'key'},
[0,"\n Logging into $host ($hostl) via ".
"$connect_method . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (2) into $host ($hostl) ",
"via $connect_method . . .\n\n";
$cache->set($cache->{'key'},
[0,"\n Logging (2) into $host ($hostl) ".
"via $connect_method . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (2) into $host ($hostlabel) via ",
"$connect_method . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
$s_err=' ';
my $gotname=0;
while (1) {
eval {
my $allines='';
my $fc='';
my $al='';
my $cmdseen=0;
## Send Login ID.
$ftp_handle->autoflush(1);
ID: while (my $line=$ftp_handle->get) {
$line||='';
$line=~tr/\r//d;
$allines.=$line;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nFFFFFFF (2) ftm_login() FFFFFFF ",
"FTP RAW OUTPUT: ==>$line<== at Line ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if (-1<index $allines,'_funkyPrompt_') {
$allines=~s/_funkyPrompt_//g;
my $fp='_funkyPrompt_';
my $stub=$line;
$stub=~/(^_fun*k*y*P*r*o*m*p*t*_*)/;
my $fs=$1;
$fs||='';
if (!$fs) {
$stub=~/(_*f*u*n*k*y*P*r*o*m*pt_$)/;
my $bs=$1;
$bs||='';
$line=~s/$bs$//s;
} else {
$line=~s/^$fs//s;
} $line=~s/^.*_funkyPrompt_//s;
}
if (!$cmdseen) {
next if $allines=~s/^\s$//s;
if (-1<index $ftp__cmd,$allines) {
next;
} elsif ((-1<index $allines,$ftp__cmd) ||
($ftp__cmd eq $allines)) {
print $ftp__cmd,"\n" if
!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::LOG
"\n ==>$ftp__cmd<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$fc=$ftp__cmd;
$fc=~s/\\/\\\\/g;
$allines=~s/^\s*$fc\s*//s;
$cmdseen=1;
next;
}
}
if ($line=~/^$fc\s*/s) {
if ($line=~/^$fc\s*$/s) {
next;
} else {
$line=~s/^$fc\s*//s;
}
}
if ($line=~/^[^f].+\n/s && $line=~/ft?p?>? ?$/s) {
if ($line!~/ftp> $/s) {
$al=$line;
next;
}
} elsif ($line!~/^.*ftp> $/) {
if ($line=~/[.]\s*$/s) {
my $lline=$allines;
chomp($lline);
$lline=~s/^.*\n(.*)$/$1/s;
$line=$lline."\n";
} elsif ($allines=~/Name.*[: ]+$/si) {
if ($line=~/(.+)\n.+$/s) {
my $stub=$1;
my $tall=$allines;
$tall=~s/Name.*[: ]+$//si;
chomp($tall);
my $ll=$tall;
$ll=~s/^.*\n(.*)$/$1/s;
if (-1<index $ll, $stub) {
$line=$ll."\n";
}
}
} elsif (-1<index $line,'A remote host refused') {
$ftp_handle->cmd('bye');
$line=~s/\s*ftp> $//s;
die $line;
} else {
$al=$line;next
}
}
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nFile_Transfer::ftm_login() LOOKING FOR FTP ",
"ERROR AFTER PASSWD OUTPUT IN CM2:->ID: SUBLOOP:",
"\n ==>$line<==\n",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
my $tline=$line;
if (-1<index $allines,'Unknown host') {
$ftp_handle->cmd('bye');
die "ftp: connect: Unknown host";
}
if (-1<index $allines,'ftp: connect:') {
$allines=~/^.*connect:\s*(.*?)\n.*$/s;
my $m=$1;$m||='';
if ((-1==index $allines,'Address already in use')
&& (-1==index $allines,'Connection timed out')
&& (-1<index $allines,'Connection refused')) {
$ftp_handle->cmd('bye');
die "ftp: connect: $m";
} elsif ($retrys++<2) {
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($shell_pid)
&& $shell_pid ne
$Net::FullAuto::FA_Core::localhost->{_sh_pid};
print "FTP_PID=$ftp_pid<== and ==>$localhost->{_cmd_pid}<==\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$ftp_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($ftp_pid)
&& $ftp_pid ne
$Net::FullAuto::FA_Core::localhost->{_cmd_pid};
$ftp_handle->close if defined fileno $ftp_handle;
sleep int $ftp_handle->timeout/3;
my $sftploginid=($su_id)?$su_id:$login_id;
my $previous_method='';$stderr='';
my $fm_cnt=-1;
if ($spawn ne 'bash') {
($ftp_handle,$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master,$_connect);
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
$ftp_handle=$ftp_handle->{_cmd_handle};
$ftp_handle->timeout($fttimeout);
} else {
#foreach $connect_method (@connect_method) {
# if (lc($connect_method) eq 'ftp') {
($ftp_handle,$ftp_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$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");
$ftp_handle=Net::Telnet->new(
Fhopen => $ftp_handle,
Timeout => $timeout);
# last;
# } elsif (lc($connect_method) eq 'sftp') {
# my $sshport='';
# if (exists
# $Net::FullAuto::FA_Core::Hosts{
# $hostlabel}{'sshport'}) {
# $Net::FullAuto::FA_Core::gbp->('sftp');
# my $sp=$Net::FullAuto::FA_Core::sftpport;
# $sshport=$sp.
# $Net::FullAuto::FA_Core::Hosts{
# $hostlabel}{'sshport'}.' ';
# }
# if (exists $Net::FullAuto::FA_Core::Hosts{
# $hostlabel}{'IdentityFile'}) {
# $sshport.='-i'.
# $Net::FullAuto::FA_Core::Hosts{
# $hostlabel}{'IdentityFile'}.' ';
# }
# print "\nSFTP CONNECT: ",
# $Net::FullAuto::FA_Core::gbp->('sftp'),
# 'sftp ',
# "${sshport}$sftploginid\@$host at Line:",
# ' ',__LINE__,"\n\n"
# if !$Net::FullAuto::FA_Core::cron &&
# $Net::FullAuto::FA_Core::debug;
# print $Net::FullAuto::FA_Core::LOG
# "\nSFTP CONNECT: ",
# $Net::FullAuto::FA_Core::gbp->('sftp'),
# 'sftp ',
# "${sshport}$sftploginid\@$host at Line:",
# " ",__LINE__,"\n\n"
# if $Net::FullAuto::FA_Core::log &&
# -1<index $Net::FullAuto::FA_Core::LOG,
# '*';
# ($ftp_handle,$ftp_pid)=
# &Net::FullAuto::FA_Core::pty_do_cmd(
# [$Net::FullAuto::FA_Core::gbp->('bash').
# 'bash','-ic',
# $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 ftp subprocess");
# $ftp_handle=Net::Telnet->new(
# Fhopen => $ftp_handle,
# Timeout => $timeout);
# last;
# }
#}
}
FH1: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys
%{$Net::FullAuto::FA_Core::Processes
{$hlabel}}) {
foreach my $type (keys
%{$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}}) {
if ($ftp_handle eq ${
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}=$value;
last FH1;
}
}
}
}
} else {
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($shell_pid)
&& $shell_pid ne
$Net::FullAuto::FA_Core::localhost->{_sh_pid};
print "FTP_PID=$ftp_pid\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$ftp_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($ftp_pid)
&& $ftp_pid ne
$Net::FullAuto::FA_Core::localhost{_cmd_pid};
&Net::FullAuto::FA_Core::handle_error(
"ftp: connect: $m\n "
."$retrys Attempts Tried",'-8','__cleanup__');
}
} elsif (-1<index $allines,'421 Service' ||
-1<index $allines,
'No address associated with name'
|| (-1<index $allines,'Connection' &&
(-1<index $allines,'Connection closed' ||
-1<index $allines,
'ftp: connect: Connection timed out'))) {
$allines=~s/s*ftp> ?$//s;
die "$allines\n $!";
}
$tline=~s/ftp> $//s;
print $tline if !$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\n DISPLAYED TO USER ==>$tline<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (-1<index $allines,
'ftp: connect: Connection timed out') {
$allines=~s/s*ftp> ?\s*$//s;
die "$allines\n $!";
} elsif ((-1<index $allines,'A remote host refused')
|| (-1<index $allines,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;
print $Net::FullAuto::FA_Core::LOG "HOSTTEST4444=$host\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($ms_share && !$ftm_only) {
if ($^O eq 'cygwin') {
my $mswin_cwd='';
($mswin_cwd,$stderr)=
&connect_share(
$Net::FullAuto::FA_Core::localhost->
{_cmd_handle},
$hostlabel);
$cmd_type='';
$ftm_type='';
if (!$stderr) {
${$work_dirs}{_tmp}=
$Net::FullAuto::FA_Core::localhost->
{'_work_dirs'}->{_tmp};
${$work_dirs}{_tmp_mswin}=
$Net::FullAuto::FA_Core::localhost->
{'_work_dirs'}->{_tmp_mswin};
${$work_dirs}{_pre_mswin}
=${$work_dirs}{_cwd_mswin};
my %cmd=(
_cmd_handle =>
$Net::FullAuto::FA_Core::localhost->
{'_cmd_handle'},
_cmd_type => '',
_work_dirs => $work_dirs,
_hostlabel => [ $hostlabel,'' ],
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $^O,
_cmd_pid =>
$Net::FullAuto::FA_Core::localhost->
{_cmd_pid},
);
$ftr_cmd=bless \%cmd, 'Rem_Command';
print "RETURNTHREE and FTR_CMD=$ftr_cmd\n";<STDIN>;
return '','',$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,'','','';
} elsif (unpack('a10',$stderr) eq 'System err'
&& $stderr=~/unknown user name/s) {
&Net::FullAuto::FA_Core::handle_error(
$stderr);
} else { $die=$stderr }
} else {
$allines=~s/^(.*)?\n.*/$1/s;
$die=$allines;
}
} else {
$allines=~s/^(.*)?\n.*/$1/s;
$die=$allines;
}
#print "NOWWWLINE=$line AND DIE=$die<==\n";
if ($die) {
$die.="Destination Host - $host, HostLabel "
."- $hostlabel\n refused an attempted "
."connect operation.\n\n Check for a "
."running FTP daemon on $hostlabel";
#&Net::FullAuto::FA_Core::handle_error($die);
die $die;
}
}
if ($allines=~/Name.*[: ]+$/si) {
#$gotname=1;$ftr_cmd='ftp';last;
$gotname=1;last;
}
}
};
#print "WHAT IS THE FTP_EVAL_ERROR2222=$@ and GOTNAME\n";
if (!$gotname && ((-1==index $@,'Unknown host') &&
(-1==index $@,'Connection refused') &&
(-1==index $@,'A remote host refused'))) {
if (1<=$#connect_method) {
$stderr=$@;
next CM2;
}
$retrys++;next;
}
if ($@) {
if ($@=~/read timed-out/) {
my $die="&ftm_login() timed-out while\n "
."waiting for a login prompt from\n "
."Remote Host - $host,\n HostLabel "
."- $hostlabel\n\n The Current Timeout"
." Setting is $fttimeout Seconds.";
&Net::FullAuto::FA_Core::handle_error($die,
'__cleanup__');
} else {
print $Net::FullAuto::FA_Core::LOG
"ftplogin() EVALERROR=$@<==\n"
if -1<index $Net::FullAuto::FA_Core::LOG,'*';
die $@;
}
} last
}
if ($su_id) {
$ftp_handle->print($su_id);
} else {
$ftp_handle->print($login_id);
}
## Wait for password prompt.
($key_authentication,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);
next;
}
}
$ftm_type='ftp';last;
} elsif (lc($connect_method) eq 'sftp') {
my $sftploginid=($su_id)?$su_id:$login_id;
my $sshport='';
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'} &&
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
$sshport.=$id.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}.' ';
}
#####4444444
print "\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$sftploginid\@$host at Line: ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$sftploginid\@$host at Line: ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($spawn eq 'bash') {
($ftp_handle,$ftp_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-lc',$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 ftp subprocess");
$ftp_handle=Net::Telnet->new(Fhopen => $ftp_handle,
Timeout => $timeout);
} else {
$ftp_handle->print($Net::FullAuto::FA_Core::gbp->('sftp').
'sftp '."${sshport}$sftploginid\@$host");
}
FH: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftp_handle eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type}=
$value;
last FH;
}
}
}
}
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet &&
!$quiet) {
# Logging (3)
print "\n Logging into $host ($hostl) via ",
"$connect_method . . .\n\n";
$cache->set($cache->{'key'},
[0,"\n Logging into $host ($hostl) via ".
"$connect_method . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (3) into $host ($hostl) via ",
"$connect_method . . .\n\n";
$cache->set($cache->{'key'},
[0,"\n Logging (3) into $host ($hostl) via ".
"$connect_method . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (3) into $host ($hostl) via $connect_method ",
" . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
## Wait for password prompt.
($key_authentication,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>'sftp',
},$timeout,1);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
if (defined $main::aws) {
sleep 10;
die $stderr;
} elsif (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print STDERR $stderr."\n";
}
die $stderr;
} else {
$ftp_handle->print('bye');
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);
next;
}
}
$ftm_type='sftp';last;
}
}
## Send password.
unless ($key_authentication) {
#print "FTM_PASSWD=$ftm_passwd<==\n";
$ftp_handle->print($ftm_passwd);
} else {
$ftp_handle->print();
}
my $lin='';my $asked=0;my @choices=();
my $authyes=0;
$ftp_handle->autoflush(1);
while (1) {
while (my $line=$ftp_handle->get(Timeout=>$fttimeout)) {
if ($line=~/command not found/) {
die 'Permssion Denied';
} elsif (-1<index $line,"Too many bad authentication attempts") {
handle_error($line,"__return__");
}
print $Net::FullAuto::FA_Core::LOG
"\nFile_Transfer::ftm_login() ",
"LOOKING FOR $ftm_type PROMPT AFTER PASSWD OUTPUT:",
"\n ==>$line<==\n ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\nFile_Transfer::ftm_login() ",
"LOOKING FOR $ftm_type PROMPT AFTER PASSWD OUTPUT:",
"\n ==>$line<==\n ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
$line=~tr/\0-\11\13-\37\177-\377//d;
chomp($line);
$lin.=$line;
if ((-1<index $lin,'Perm') || $lin=~/\s+[Pp]assword[:\s]+$/s) {
if ($lin=~/[Pp]assword[:\s]+$/s) {
if ($su_id && $su_id ne $login_id) {
if (!$asked++) {
my $error='';
($error=$lin)=~s/^\s*(.*)\n.*$/$1/s;
if ($error=~/^\s*[Pp]assword[:\s]+$/s) {
$error='Password *NOT* accepted';
}
$error||='Password *NOT* accepted';
my $asktimeout=300;my $a='';my $choice='';
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB:
# \n required
alarm $asktimeout;
my $banner="\n *** THIS SCREEN WILL "
."TIMEOUT IN 5 MINUTES ***\n"
."\n The Host \"$hostlabel\" is "
."configured to attempt a su\n with "
."the ID \'$su_id\'\; however, the first "
."attempt\n resulted in the following "
."Error :\n\n $error\n\n It "
."may be that sftp is configured to "
."disallow logins\n with \'$su_id\'\."
."\n\n Please Pick an Operation :\n"
."\n NOTE: Choice will affect all "
."future logins!\n";
$choices[0]=
"Re-enter password and re-attempt with "
."\'$su_id\'";
$choices[1]=
"Attempt login with base id \'$login_id\'";
$choice=&Term::Menus::pick(\@choices,$banner);
chomp $choice;
};alarm(0);
$choice||=']quit[';
if ($choice ne ']quit[') {
if ($choice=~/$su_id/s) {
my $passwd_timeout=350;
my $te_time=time;
my $show='';my $save_passwd='';
($show=$lin)=~s/^.*?\n(.*)$/$1/s;
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
# \n required
alarm($passwd_timeout);
&acquire_fa_lock(9854);
print $Net::FullAuto::FA_Core::blanklines;
if ($Net::FullAuto::FA_Core::debug) {
$show=~s/:\s*$//s;
print "\n$show (5): ";
} else {
print "\n$show ";
}
Term::ReadKey::ReadMode 2;
$save_passwd=<STDIN>;
Term::ReadKey::ReadMode 0;
&release_fa_lock(9854);
};alarm(0);
if ($@ eq "alarm\n") {
print "\n\n";
my $errmsg.="\n\n Time Allowed for ".
"Password Input has Expired.\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq
'notify_on_error') {
my $body='';
if ($errmsg) {
if ($Net::FullAuto::FA_Core::debug) {
$body="\n ERROR MESSAGE (6) "
."-> $errmsg";
} else {
$body="\n ERROR MESSAGE -> "
.$errmsg;
}
}
$body.=$show;my $subject='';
if ($host) {
$subject="Login Failed for $su_id ".
"on $host";
} else {
$subject="Authentication Failed";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);
&Net::FullAuto::FA_Core::send_email(
\%mail);
}
&handle_error(
"Time Allowed for Password Input ".
"has Expired.",'__cleanup__');
}
chomp $save_passwd;
$ftp_handle->print($save_passwd);
print $Net::FullAuto::FA_Core::LOG $show
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$lin='';
} else {
$ftp_handle->print("\003");
$ftp_handle->print;
while (my $line=$ftp_handle->get) {
print "TRYING TO USE NEW PASSWORDLINE=$line<==\n";
print $Net::FullAuto::FA_Core::LOG "LLINE44=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$line=~s/\s*$//s;
last if $line=~/_funkyPrompt_$/s;
last if $line=~/Killed by signal 2\.$/s;
} $lin='';
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
$sshport.=$id.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}.' ';
}
&Net::FullAuto::FA_Core::su_scrub(
$hostlabel,$su_id,$ftm_type);
&Net::FullAuto::FA_Core::passwd_db_update(
$hostlabel,$su_id,'DoNotSU!',
$ftm_type,$sshport);
$ftp_handle->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').
'sftp '."${sshport}$login_id\@$host");
## Wait for password prompt.
($key_authentication,$stderr)=
&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&clean_filehandle($ftp_handle);
next;
}
}
## Send password.
print "111 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";
my $ftm_passwd=
&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');
$ftp_handle->print($ftm_passwd);
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||
$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (4)
print "\n Logging into $host (",
"$hostl) ",
"via $ftm_type . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host (".
"$hostl) ",
"via $ftm_type . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print
"\n Logging (4) into $host (",
"$hostl) ",
"via $ftm_type . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging (4) into $host (".
"$hostl) ",
"via $ftm_type . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (4) into $host (",
"$hostl) ",
"via $ftm_type . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index
$Net::FullAuto::FA_Core::LOG,'*';
last;
}
} else {
&Net::FullAuto::FA_Core::cleanup();
}
} elsif ($asked<4) {
print "YESSSSSSS WE HAVE DONE IT FOUR TIMES11\n";<STDIN>;
}
} else {
## Send password.
my $showerr='';
($showerr=$lin)=~s/^.*?\n(.*)$/$1/s;
$showerr=~s/^(.*)?\n.*$/$1/s;
$showerr='' if $showerr=~/Password Authentication/s;
$retrys++;
if ($login_id eq 'root') {
$showerr="$showerr\n\n HINT: sftp may not be "
."configured to allow \'root\' access."
."\n If ssh connectivity & su root is "
."available, try setting\n SU_ID =>"
." \'root\' in "
."$Net::FullAuto::FA_Core::fa_host\n";
}
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$showerr,$ftm_type);
$ftp_handle->print($ftm_passwd);
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||
$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (5)
print "\n Logging into $host ($hostl) ",
"via $ftm_type . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostl) ".
"via $ftm_type . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print
"\n Logging (5) into $host ($hostl) ",
"via $ftm_type . . .\n\n";
$cache->set($cache->{'key'},[0,"\n ".
"Logging (5) into $host ($hostl) ".
"via $ftm_type . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (5) into $host ($hostl) ",
"via $ftm_type . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
$lin='';next;
}
} elsif ($line=~/_funkyPrompt_$|Connection closed/s) {
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
$sshport.=$id.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}.' ';
}
$ftp_handle->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').'sftp '.
"${sshport}$login_id\@$host");
## Wait for password prompt.
($key_authentication,$stderr)=
&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&clean_filehandle($ftp_handle);
next;
}
}
## Send password.
print $Net::FullAuto::FA_Core::LOG
"333 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');
$ftp_handle->print($ftm_passwd);
my $showsftp="\n LoggingF into "
."$host via sftp . . .\n\n";
print $showsftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::LOG $showsftp
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last;
}
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
print "AUTHENHERE!1111\n";<STDIN>;
my $question=$lin;
$question=~s/^.*(The authen.*)$/$1/s;
$question=~s/\' can\'t/\'\ncan\'t/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$question ";
my $answer=<STDIN>;
chomp $answer;
if (lc($answer) eq 'yes') {
$ftp_handle->print($answer);
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$authyes=1;$lin='';last;
} elsif (lc($answer) eq 'no') {
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::cleanup()
}
}
} elsif ($lin=~/channel is being closed/s) {
$lin=~s/\s*//s;
$lin=~s/^(.*)?\n.*$/$1/s;
my $warning=$lin;
$warning=~tr/\015//d;
$warning=~s/^/ /gm;
$warning="WARNING! - sftp on Host $host is not configured\n"
." for user $login_id :\n\n$warning";
&Net::FullAuto::FA_Core::handle_error(
$warning,'__return__','__warn__');
die $lin;
} elsif ($line=~/^530 /m) {
$line=~s/^.*(530.*)/$1/s;
$line=~s/\s*ftp\>\s*$//s;
$line=~s/\n/\n /s;
die "$line\n";
}
if ($line=~/[\$\%\>\#\-\:]+ ?$/m) {
$lin='';last;
} elsif ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
$lin='';last;
} elsif ($lin=~/Perm/s && $lin=~/password[: ]+$/si) { last }
}
if ($lin=~/Perm/s) {
$lin=~s/\s*//s;
$lin=~s/^(.*)?\n.*$/$1/s;
die "$lin\n";
} else { last }
}
my %ftp=(
_ftp_handle => $ftp_handle,
_ftp_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $^O,
_work_dirs => $work_dirs,
_hostlabel => [ $hostlabel,
$Net::FullAuto::FA_Core::localhost->{
'_hostlabel'}->[0] ],
_ftp_pid => $ftp_pid
);
# Make sure prompt won't match anything in send data.
$ftp_handle->prompt("/s*ftp> ?\$/");
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'pwd',$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
my $rwd='Remote working directory:';
my $icd=' is the current directory';
($homedir=$output)=~s/^(?:257 ["]|$rwd\s+)(.*)?(?:["]$icd)*$/$1/s;
if ($_connect ne 'connect_sftp' && $_connect ne 'connect_ftp') {
my $ftmtype='';
if ($ms_hostlabel) {
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($ms_hostlabel,$ftp_handle,
$new_master,$_connect,$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1','__cleanup__')
if $stderr;
$ftm_type=$ftmtype if $ftmtype;
if ($su_id) {
$Net::FullAuto::FA_Core::Connections
{"${hostlabel}__%-$su_id"}=$ftr_cmd;
} else {
$Net::FullAuto::FA_Core::Connections
{"${hostlabel}__%-$login_id"}=$ftr_cmd;
}
} else {
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($hostlabel,$ftp_handle,
$new_master,$_connect,$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$ftm_type=$ftmtype if $ftmtype;
}
}
#$ftp_handle->print("quote stat");
#while ($line=$ftp_handle->get) {
# print "FTPLINE2=$line\n";
# last if $line=~/ftp>\s*/s;
#};<STDIN>;
};
if ($@) {
handle_error($@) if $@=~/^FATAL ERROR/;
$ftm_errmsg=$@;
#print "FTM_LOGIN_ERRMSG=$ftm_errmsg and FTM_PID=$ftp_pid and SHELLPID=$shell_pid<===\n";
print "sub ftm_login FTM_LOGIN_ERROR=$ftm_errmsg<==\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"sub ftm_login FTM_LOGIN_ERROR=$ftm_errmsg<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (unpack('a4',$ftm_errmsg) eq 'read' ||
(-1<index $ftm_errmsg,'421 Service') ||
(-1<index $ftm_errmsg,'Connection refused') ||
(-1<index $ftm_errmsg,'Connection closed') ||
(-1<index $ftm_errmsg,'Unknown host') ||
(-1<index $ftm_errmsg,'A remote host refused')) {
my $host= $hostname ? $hostname : $ip;
print $Net::FullAuto::FA_Core::LOG
"HOSTTEST6666=$host\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName} if $hostlabel=~/^__Mast/;
$ftm_errmsg="$@\n While Attempting "
."Login to $host\n -> HostLabel "
."\'$hostl\'\n\n";
if (unpack('a4',$ftm_errmsg) eq 'read') {
$ftm_errmsg.=" Current Timeout "
."Setting is -> " . $ftp_handle->timeout
." seconds.\n\n";
}
if (($retrys<10 && defined $main::aws) ||
($retrys<2 && unpack('a4',$ftm_errmsg) eq 'read')) {
$retrys++;
warn "$ftm_errmsg $!" unless defined $main::aws;
if (defined fileno $ftp_handle) {
$ftp_handle->print; # if defined fileno $ftp_handle;
eval {
while (my $line=$ftp_handle->get) {
print $Net::FullAuto::FA_Core::LOG
"File_Transfer::ftm_login() LOOKING FOR PROMPT=$line\n and ERROR=$@\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#print "File_Transfer::ftm_login() LOOKING FOR PROMPT=$line\n and ERROR=$@\n";
if ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
return $ftp_handle,$ftp_pid,$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,'','',$die;
} elsif ($line=~
/logout|Connection.*closed|A remote host refused|_funkyPrompt_/s) {
last;
}
}
};
}
FTH: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{
$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftp_handle eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
last FTH;
}
}
}
}
$ftp_handle->close;
if ($ftm_errmsg=~/421 Service/s ||
$ftm_errmsg=~/Connection closed/s) {
&Net::FullAuto::FA_Core::handle_error("$ftm_errmsg$s_err");
}
next;
} else {
print "\nEXITING from ftm_login() ERROR: $@\n at Line ",
__LINE__,"\n ".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
$die=$ftm_errmsg;
$ftp_handle=Bad_Handle->new($hostlabel,$die);
last;
}
}
$die_login_id=($su_login)?$su_id:$login_id;
if ($retrys<2 &&
(-1==index $ftm_errmsg,'No more authentication methods')) {
if ($ftm_errmsg=~/530 |Perm|(channel is being closed)/) {
my $shipht=$1;
shift @connect_method if $shipht;
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
}
$retrys++;
$retrys=0 if $shipht;
print "\nRETRYING from ftm_login() ERROR: $ftm_errmsg\n",
" at Line ",__LINE__,"\n ".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
$ftp_handle->print("\003");
$ftp_handle->get;
$ftp_handle->print('bye');
while (my $line=$ftp_handle->get) {
last if $line=~/_funkyPrompt_|221 Goodbye/s;
}
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($shell_pid)
&& $shell_pid ne
$Net::FullAuto::FA_Core::localhost->{_sh_pid};
$Net::FullAuto::FA_Core::localhost{_cmd_pid}||='';
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$ftp_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($ftp_pid)
&& $ftp_pid ne $Net::FullAuto::FA_Core::localhost{_cmd_pid};
$ftp_handle->close;
if (-1<$#connect_method && ($shipht ||
!$Net::FullAuto::FA_Core::cron)) {
next;
}
} elsif (unpack('a10',$ftm_errmsg) eq 'System err' &&
$ftm_errmsg=~/unknown user name/s) {
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
} $retrys++;next if !$Net::FullAuto::FA_Core::cron;
}
} else { shift @connect_method;next if $#connect_method }
if (unpack('a10',$ftm_errmsg) eq 'The System') {
$die="$ftm_errmsg$s_err";
} else {
my $f_t=$ftm_type;$f_t=~s/^(.)/uc($1)/e;
$ftm_errmsg=~s/^(.*)\n *(.*)$/$1\n $2/s;
$die="The Host $host Returned\n the "
."Following Unrecoverable Error Condition\,\n"
." Rejecting the $f_t Login Attempt"
." of the ID\n -> $die_login_id:"
."\n\n $ftm_errmsg\n$s_err"
." at ".(caller(0))[1]." "
."line ".(caller(2))[2].".\n\n ";
} last;
} else { last }
last if $die;
} return $ftp_handle,$ftp_pid,$work_dirs,$homedir,$ftr_cmd,
$ftm_type,$cmd_type,'','',$die;
} ## END of &ftm_login
sub wait_for_passwd_prompt
{
## Wait for password prompt.
my @topcaller=caller;
print "\nINFO: File_Transfer::wait_for_passwd_prompt() ",
"(((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
my $filehandle=$_[0];
my $timeout=$_[1]||$Net::FullAuto::FA_Core::timeout;
my $notnew=$_[2]||'';
my $login_Mast_error=$_[3]||'';
my $loop_count=$_[4]||0;
my $hostlabel=$_[5]||'localhost';
my $password=$_[6]||'';
my $lin='';my $authyes=0;my $gotpass=0;my $warning='';
my $eval_stdout='';my $eval_stderr='';$@='';
my $connect_err=0;my $count=0;
$filehandle->{_cmd_handle}->autoflush(1);
my $starttime=time;
unless ($notnew) {
my $ssh_notice=<<END;
################### NOTICE ####################
It appears that this is the first time FullAuto
is starting on this host. It may take a few
seconds - or even *MINUTES* (in rare cases) for
the intial configuration of Secure Shell to
complete. All future FullAuto startups will go
*MUCH* faster. Please be patient.
END
my $dotsshpath=($^O eq 'cygwin')?$ENV{HOME}:'/root';
unless (-e $dotsshpath.'/.ssh' &&
&Net::FullAuto::FA_Core::grep_for_string_existence_only(
$dotsshpath.'/.ssh/known_hosts',qr/^localhost/)) {
print $ssh_notice unless $login_Mast_error;
}
}
my ($returned)=eval {
while (1) {
last if $gotpass;
PW: while (my $line=$filehandle->{_cmd_handle}->get(
Timeout=>$timeout)) {
#print "LOGIN OUTPUT LINE=$line<=\n";
local $SIG{ALRM} = sub { die "read timed-out:do_slave\n" };
# \n required
alarm $timeout+1;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nPPPPPPP wait_for_passwd_prompt() PPPPPPP ",
"CMD RAW OUTPUT: ==>$line<== at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
$lin.=$line;
if ((-1<index $line,
'Next authentication method: keyboard-interactive') ||
(-1<index $line,'Next authentication method: password')) {
if ($lin=~/can[']t open \/dev\/tty: No such device or/s) {
die "can\'t open /dev/tty: No such device or address\n";
} elsif ($lin=~/password[: ]+$/s) {
$determine_password->($login_Mast_error,$loop_count,
$hostlabel,$password);
$eval_stdout='';$eval_stderr='';
$gotpass=1;last PW;
} else { next }
} elsif (-1<index $line,'/dev/tty: No') {
die "can\'t open /dev/tty: No such device or address\n";
} elsif (-1<index $line,'Authentication succeeded (publickey)') {
return $line,'';
} elsif (-1<index $lin,'/bin/bash: Operation not permitted') {
Net::FullAuto::FA_Core::bash_operation_not_permitted(
$hostlabel);
} elsif (-1<index $line,'Permission denied') {
if (-1<index $line, 'publickey') {
chomp $line;
die $line;
}
die 'Permission denied';
} elsif ($line=~/sftp>\s*$/s) {
return 'key_authenticated','';
} elsif ($warning || (-1<index $line,'@@@@@@@@@@')) {
$warning.=$line;
$count++ if $line=~/^\s*$/s;
if ($warning=~/Connection closed|Connection reset/s
|| $count==10) {
$warning=~s/_funkyPrompt_//s;
$warning=~s/^/ /gm;
$warning=~s/\s*$//s;
if ($count==10) {
die "read timed-out\n";
}
die "\n".$warning;
} $filehandle->{_cmd_handle}->print;
next;
} elsif (-1<index $lin,'Address already in use') {
die 'Connection closed';
} elsif (-1< index $lin,'Write failed: Broken pipe') {
die "read timed-out\n";
#} elsif (-1<index $lin,'No route to host') {
# die $lin;
} elsif (-1<index $lin,'Connection reset by peer') {
if ($lin=~s/^.*(ssh:.*)$/$1/s) {
$lin=~s/Could/ Could/s;
$lin=~s/_funkyPrompt_//s;
die $lin;
} else {
$lin='Connection closed';
}
die $lin;
} elsif (7<length $line && unpack('a8',$line) eq 'Insecure') {
$line=~s/^Insecure/INSECURE/s;
$eval_stdout='';$eval_stderr=$line;
die $line;
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
# http://www.unix.com/shell-programming-and-scripting/ \
# 152781-bash-capturing-anything-showed-screen-2.html \
# ?s=f57e76256a75d0cda455148a30e86152
unless ($authorize_connect) {
my $question=$lin;
$question=~s/^.*(The authen.*)$/$1/s;
$question=~s/\' can\'t/\'\ncan\'t/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$question ";
alarm(0);
my $authtimeout=120;my $a='';
my $answer='';
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
# NB: \n required
alarm $authtimeout;
$answer=<STDIN>;
};alarm(0);
if (!$authorize_connect && ($@ || !$answer)) {
print
"\n\n","This request for autenticity timed",
" out and FullAuto terminated.",
"\nTo provide permission for this request",
" run FullAuto with the\n --authorize_connect",
" argument.\n\n";
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
&Net::FullAuto::FA_Core::cleanup()
} elsif ($a=~/^[Nn]$/s) {
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::cleanup()
}
chomp $answer;
if (lc($answer) eq 'yes' or $authorize_connect) {
$filehandle->{_cmd_handle}->print('yes');
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$authyes=1;$lin='';
last;
} elsif (lc($answer) eq 'no') {
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
alarm(0);
&Net::FullAuto::FA_Core::cleanup()
}
}
} else {
$filehandle->{_cmd_handle}->print('yes');
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$authyes=1;$lin='';
last;
}
} elsif ($lin=~/password[: ]+$/si) {
print $Net::FullAuto::FA_Core::LOG
"wait_for_passwd_prompt() PASSWORD PROMPT=$lin<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#print "DO WE GET HERE TWO\n";sleep 5;
$determine_password->($login_Mast_error,$loop_count,$hostlabel)
if $filehandle->{_hostlabel}->[0]=~/__Master_${$}__/;
#print "DONE WITH DETERMINE\n";<STDIN>;
$gotpass=1;last PW;
} elsif ((-1<index $lin,'530 ')
|| (-1<index $lin,'421 ')
|| (-1<index $lin,'Connection refused')
|| (-1<index $lin,'Connection closed')
|| (-1<index $lin,'ssh: Could not')
|| (-1<index $lin,'name not known')
|| (-1<index $lin,'Could not create')) {
$lin=~tr/\0-\11\13-\31\33-\37\177-\377//d;
chomp($lin);
my $fulllin=$lin;
$lin=~/(^530[ ].*$)|(^421[ ].*$)
|(^Connection[ ]refused.*$)
|(^Connection[ ]closed.*$)
|(^ssh:[ ]Could[ ]not.*)/xm;
$lin=$1 if $1;$lin=$2 if $2;
$lin=$3 if $3;$lin=$4 if $4;
$lin=$5 if $5;
if (-1<index $lin,'Connection refused') {
die 'Connection refused';
} elsif (-1<index $lin,'Permanently added' &&
-1<index $lin,'Roaming not allowed' &&
-1<index $lin,'Connection closed') {
die $lin;
} elsif (-1<index $lin,'name not known') {
die $lin;
} elsif (-1<index $lin,'Connection closed') {
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;
$fulllin=~s/^(.*?)\n(.*)/$2/s;
my $fcmd=$1;
$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 ";
die $fulllin;
}
die $lin;
} elsif (-1<index $lin,'Could not create') {
if ($^O eq 'cygwin') {
my $die="$lin\n ".
"Hint: Make sure there are no quote characters\n".
" used in the /etc/passwd file.\n";
$eval_stdout='';$eval_stderr=$die;
die $eval_stderr;
}
$eval_stdout='';$eval_stderr=$lin;
die $eval_stderr;
} else {
$eval_stdout='';$eval_stderr=$lin;
die $eval_stderr;
}
}
if ($lin=~/Warning/s) {
$lin=~s/^.*(Warning.*)$/$1/s;
print "\n$lin";sleep 1;
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
} alarm(0);
last if $gotpass;
}
};alarm(0);
if ($@) {
if (wantarray) {
my $error=$@;
$error=~tr/\0-\11\13-\37\177-\377//d;
chomp($error);
if ($error=~/Permission denied/) {
if ($error=~/publickey/) {
my $publickey_failed=<<'END';
___ _ _ _ _ __
| _ \_ _| |__| (_)__| |/ /___ _ _
| _/ || | '_ \ | / _| ' </ -_) || |
|_| \_,_|_.__/_|_\__|_|\_\___|\_, |
|__/
_ _ _ _ _ _ _
/_\ _ _| |_| |_ ___ _ _| |_(_)__ __ _| |_(_)___ _ _
/ _ \ || | _| ' \/ -_) ' \ _| / _/ _` | _| / _ \ ' \
/_/ \_\_,_|\__|_||_\___|_||_\__|_\__\__,_|\__|_\___/_||_|
( ____
)\ ) ( ( | /
(()/( ) ( )\ ( )]\ ) | /
/(_))( /( )\ ((_) ))\ (()/( | /
(_))_|)(_))((_) _ /((_) ((_)) |/
| |_ ((_)_ (_)| |(_)) _| | (
| __|/ _` | | || |/ -_)/ _` | )\
|_| \__,_| |_||_|\___|\__,_|((_)
END
if (grep { /__Master_${$}__/ } @{$filehandle->{_hostlabel}}) {
my $amazon='';
if ($amazon=
&Net::FullAuto::FA_Core::check_for_amazon_localhost) {
print $Net::FullAuto::FA_Core::blanklines;
print $publickey_failed;
sleep 3;
my $user=$Net::FullAuto::FA_Core::username;
my $user_path=($user eq 'root')?'/root':"/home/$user";
my $pbf_banner=<<END;
[]![] PublicKey Authentication FAILED []![]
FullAuto works with Amazon EC2 Servers the same way you do. You
connected to this server with a private key file similar to this:
ssh -i <filename>.pem $user\@$amazon->[1]
In order for FullAuto to connect, the same key must be used:
fa -i <filename>.pem <== Always use THIS on Amazon EC2
------------------
Upload this *same* key from your local computer to this host with
this single command (run this from your local computer - NOT here):
scp -i <filename>.pem <filename>.pem $user\@$amazon->[1]:$user_path
-OR- with PuTTY scp (but only if you are using PuTTY):
pscp -i <filename>.ppk <filename>.pem $user\@$amazon->[1]:$user_path
END
my $wait_banner=<<'END';
___ _ _ _ _ _ _
|_ _|( )| | | __ __ ____ _(_) |_| |
| | V | | | \ V V / _` | | _|_|
|___| |_|_| \_/\_/\__,_|_|\__(_) (for 5 minutes)
If you can, go ahead and upload the private key mentioned on the
previous page right now. (If you need to review the instructions
again, just use the LEFTARROW [<] to navigate back to the previous
page.)
The key should be uploaded to the /home/$user directory. When
FullAuto detects the key in the /home/$user directory, it will
authenticate and proceed to the next page automatically. Otherwise,
FullAuto will timeout and gracefully exit in 5 minutes.
If you would like to quit and continue later, just press the ESC key.
END
my $i_will_wait_sub=sub {
package i_will_wait_sub;
use Net::FullAuto::FA_Core;
my $key=
"$main::aws->{credpath}/$main::aws->{pem_file}";
if (-e $key) {
my $cmd="/usr/local/bin/fa ".
"-i $key ".
"--iset-amazon --log";
print "\n";
{
no warnings;
exec $cmd;
};
}
my %i_will_wait=(
Name => 'i_will_wait',
Banner => $wait_banner,
Result => sub {
package i_will_wait;
use Net::FullAuto::FA_Core;
my $key=$main::aws->{credpath}.
'/'.$main::aws->{pem_file};
my $gotkey=0;
foreach my $sec (1..300) {
sleep 1;
if (-e $key) {
$gotkey=1;
last;
}
}
my $cmd="/usr/local/bin/fa ".
"-i $key ".
"--iset-amazon --log";
if ($gotkey) {
print "\n";
{
no warnings;
exec $cmd;
};
} else {
cleanup();
}
},
);
return \%i_will_wait;
};
my %publickey_failed=(
Name => 'publickey_failed',
Result => $i_will_wait_sub,
Banner => $pbf_banner,
);
&Term::Menus::Menu(\%publickey_failed);
print "DO AMAZON HANDLING\n";
&Net::FullAuto::FA_Core::cleanup();
}
}
print "DO OTHER\n";
&Net::FullAuto::FA_Core::cleanup();
}
#print "do_slave ONE and ERROR=$error\n";
return ('','read timed-out:do_slave')
} elsif ($@=~/can[']t open \/dev\/tty: No such device or/s) {
return '',
"can\'t open /dev/tty: No such device or address\n";
} elsif ($@!~/Connection closed/ &&
(-1==index $@, 'name not known')) {
my $err=$@;
eval {
$filehandle->{_cmd_handle}->print;
my $cnt=0;
while (my $line=$filehandle->{_cmd_handle}->get) {
last if $line=~/_funkyPrompt_/s;
$filehandle->{_cmd_handle}->print;
last if $cnt++==10;
}
if ($cnt==11 and (-1<index $err,'read timed-out')
&& !$slave) {
#print "do_slave TWO and ERROR=$error\n";
$error='read timed-out:do_slave';
}
};
if ($error eq 'read timed-out:do_slave') {
#print "do_slave THREE and ERROR=$error\n";
return ('','read timed-out:do_slave')
}
} return '', $error;
} else {
&Net::FullAuto::FA_Core::handle_error($@)
}
} elsif ($returned) {
if (wantarray) {
return $returned,'';
} else {
return $returned;
}
} elsif (wantarray) {
return $eval_stdout,$eval_stderr;
} elsif ($eval_stderr) {
&Net::FullAuto::FA_Core::handle_error($@);
} else {
return $eval_stdout;
}
} ## END of &wait_for_passwd_prompt
sub connect_share
{
my @topcaller=caller;
print "File_Transfer::connect_share() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"File_Transfer::connect_share() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my (@outlines,@errlines)=();
my $cmd_handle=$_[0];
my $hostlabel=$_[1];
my $_connect=$_[2]||'';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cdtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my ($output,$stdout,$stderr)=('','','');
my $cnct_passwd='';
my $host=($use eq 'ip')?$ip:$hostname;
my @output=$cmd_handle->cmd(
"net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1");
#print "OUTPUT=@output and CMDHANDLE=$cmd_handle\n";
for (@output) {
push @{ s/stdout: // ? \@outlines : \@errlines }, $_;
} $stdout=join '', @outlines;
$stderr=join '',@errlines;@output=();
if ($stdout) {
my $ms_cnct='net use \\\\'.$host.'\\'.$ms_share;
$login_id=$su_id if $su_id;
my $dom='';
if ($ms_domain) {
$dom=$ms_domain.'\\';
} else {
if (($host=~tr/.//)==2) {
$dom=substr($host,0,(index $host,'.')) . '\\';
} else {
$dom=$host.'//';
}
}
if ($su_id) {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
'','__su__');
} else {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,$ms_share,'');
}
while (1) {
my $ms_cmd="$ms_cnct $cnct_passwd /USER:$dom"
.$login_id;
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },$ms_cmd);
if (!$stderr ||
(-1<index $stderr,'credentials supplied conflict')) {
return "\\\\$host\\$ms_share\\",'';
} elsif (-1<index $stderr,'Logon failure') {
if ($su_id) {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$stderr,'__force__','__su__');
} else {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,$ms_share,
$stderr,'__force__');
}
} else {
$stderr="From Command :\n\n $ms_cmd\n\n "
."$stderr\n $!";
return '','',$stderr;
}
}
} else {
$stderr=~s/^/ /mg;
$stderr=~s/\s*//;
$stderr="From Command :\n\n "
."net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1"
."\n\n$stderr\n $!";
return '','',$stderr;
}
}
sub cwd
{
my @topcaller=caller;
print "\nINFO: File_Transfer::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nFile_Transfer::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];
my $target_dir=$_[1];
my $cache=$_[2]||'';
$target_dir||='';
$target_dir=~s/[\/\\]*$//
if $target_dir ne '/' && $target_dir ne '\\';
my $len_tdir=length $target_dir;
my $output='';my $stderr='';
if (unpack('a1',$target_dir) eq '.') {
if ($target_dir eq '.') {
if (wantarray) {
return '\'.\' is Current Directory','';
} else { return '\'.\' is Current Directory' }
} elsif (1<$len_tdir &&
(unpack('a2',$target_dir) eq './')
|| unpack('a2',$target_dir) eq '.\\') {
$target_dir=unpack('x2,a*',$target_dir);
}
}
my $hostlabel=$self->{_hostlabel}->[0]||$self->{_hostlabel}->[1];
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cwtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$self->{_connect});
my $host=($use eq 'ip')?$ip:$hostname;
if (!$target_dir) {
my @caller=caller;
my $die="The First Argument to cwd is being "
."read by\n $0 as a null or ''. "
."Hint: (Perhaps a\n variable being "
."used to pass the destination-\n "
."directory-name is misspelled) in file\n"
." -> $caller[1] line $caller[2]\n\n";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
if ((exists $self->{_work_dirs}->{_cwd} &&
$target_dir eq $self->{_work_dirs}->{_cwd}) ||
(exists $self->{_work_dirs}->{_cwd_mswin} &&
$self->{_work_dirs}->{_cwd_mswin} &&
$target_dir eq $self->{_work_dirs}->{_cwd_mswin})) {
if (wantarray) {
return 'CWD command successful.','';
} else { return 'CWD command successful.' }
} elsif ($target_dir eq '-' || $target_dir eq '~'
|| $target_dir=~/^\.\./) {
if ($self->{_work_dirs}->{_pre}) {
my $chdir='';
if ($target_dir eq '-') {
$chdir=$self->{_work_dirs}->{_pre};
} elsif ($target_dir!~/^\.\./) {
$chdir=$self->{_homedir};
} else { $chdir=$target_dir }
if (exists $self->{_cmd_handle} && $self->{_cmd_handle}) {
($output,$stderr)=$self->{_cmd_handle}->cmd("cd $chdir");
}
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr) {
my $die="\n\n --> $target_dir\n\n"
." DOES NOT EXIST!: $!";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die,'-7') }
}
if ($self->{_ftp_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftp_type =>$self->{_ftp_type} },
"cd \"$chdir\"",$cache);
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
}
my $save_pre=$self->{_work_dirs}->{_pre};
if ($chdir=~/^\.\./) {
$self->{_work_dirs}->{_pre}=
$self->{_work_dirs}->{_cwd};
if ($self->{_ftp_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftp_type =>$self->{_ftp_type} },
"pwd",$cache);
$output=~s/Remote working directory: (.*)/$1/;
$self->{_work_dirs}->{_cwd}=$output.'/';
$stderr=$output if -1<index $output,"Couldn't can";
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");
$self->{_work_dirs}->{_cwd}=$output.'/';
}
} else {
$self->{_work_dirs}->{_pre}=
$self->{_work_dirs}->{_cwd};
if ($target_dir eq '-') {
$self->{_work_dirs}->{_cwd}=$save_pre;
} else {
$self->{_work_dirs}->{_cwd}=
$self->{_homedir};
}
}
if (wantarray) {
return 'CWD command successful.','';
} else { return 'CWD command successful.' }
} elsif (wantarray) {
return 'CWD command successful.','';
} else { return 'CWD command successful.' }
}
print $Net::FullAuto::FA_Core::LOG "GOING TO EVAL and $self->{_uname}\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my @return=eval {
if (($self->{_uname} eq 'cygwin') &&
($target_dir=~/^\\\\|^([^~.\/\\][^:])/
&& (exists $self->{_work_dirs}->{_cwd_mswin} &&
1<length $self->{_work_dirs}->{_cwd_mswin} &&
unpack('a2',$self->{_work_dirs}->{_cwd_mswin})
eq '\\\\') && !(exists $self->{_cygdrive} &&
$target_dir=~/^$self->{_cygdrive}/))) {
my $td=$1;my $tar_dir='';
if ($td) {
if ($td=~/^[\/\\][^:]/) {
if ($ms_share) {
if (($tar_dir=$target_dir)=~s/\//\\/g) {
$tar_dir=~s/\\/\\\\/g;
}
$tar_dir="\\\\$host\\$ms_share$tar_dir";
} else {
my $die='Cannot Determine Root -or- Drive -or- Share'
."\n for Directory $target_dir";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif (exists $self->{_work_dirs}->{_cwd_mswin} &&
1<length $self->{_work_dirs}->{_cwd_mswin} &&
unpack('a2',$self->{_work_dirs}->{_cwd_mswin})
eq '\\\\') {
if (($tar_dir=$target_dir)=~s/\//\\/g) {
$tar_dir=~s/\\/\\\\/g;
}
$tar_dir=$self->{_work_dirs}->{_cwd_mswin}.$tar_dir;
} else {
my $die='Cannot Determine Root -or- Drive -or- Share'
."\n for Directory $target_dir";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} else {
$tar_dir=$target_dir;
}
my @output=();my $cnt=0;
while (1) {
($output,$stderr)=$self->{_cmd_handle}->
cmd("cmd /c dir /-C \"$tar_dir\"");
$stderr=$output if -1<index $output,"Couldn't can";
if (!$stderr && substr($output,-12,-2) ne 'bytes free') {
$output='';next unless $cnt++;
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$tar_dir\"\n"
."\n run on the host $hostlabel FAILED";
&Net::FullAuto::FA_Core::handle_error($die);
} else { last }
}
my $outdir='';
($outdir=$output)=~s/^.*Directory of ([^\n]*).*$/$1/s;
$outdir=~tr/\0-\37\177-\377//d;
if ($outdir eq $tar_dir) {
$self->{_work_dirs}->{_pre_mswin}=
$self->{_work_dirs}->{_cwd_mswin};
$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';
$output="CWD command successful";
} else {
$output=~s/^.*Directory of [^\n]*(.*)$/$1/s;
my $leaf=substr($tar_dir,(rindex $tar_dir,"\\")+1);
foreach my $line (split /\n/, $output) {
$line=~tr/\0-\37\177-\377//d;
if ($line=~/$leaf$/ and $line!~/\<DIR\>/) {
my $die="Cannot cwd to the FILE:"
."\n\n --> $tar_dir\n\n"
." Because First cwd() Argument"
."\n Must be a Directory.\n";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
my $die="Cannot cwd to the Directory:"
. "\n\n --> $tar_dir\n\n"
. " The Directory DOES NOT EXIST!\n";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif ($target_dir=~/^([^~.\/\\][^:]?)/) {
$target_dir=~s/\\/\//g;
if (exists $self->{_work_dirs}->{_cwd}) {
$self->{_work_dirs}->{_pre}=
$self->{_work_dirs}->{_cwd};
$target_dir=$self->{_work_dirs}->{_cwd}.
$target_dir;
} else {
$self->{_work_dirs}->{_pre}=$self->{_homedir};
$target_dir=$self->{_homedir}.$target_dir;
}
if (exists $self->{_cmd_handle} && $self->{_cmd_handle}) {
($output,$stderr)=$self->{_cmd_handle}->
cmd("cd $target_dir");
$stderr=$output if -1<index $output,"Couldn't can";
}
my $phost=$hostlabel;
if ($stderr) {
my $die="The Destination Directory on Host "
."- $phost :"
."\n\n --> $target_dir\n\n"
." DOES NOT EXIST!: $!";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die,'-12') }
}
if ($self->{_ftp_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftp_type =>$self->{_ftp_type} },
"cd \"$target_dir\"",$cache);
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
}
$self->{_work_dirs}->{_cwd}=$target_dir.'/';
if ($self->{_uname} eq 'cygwin') {
$self->{_work_dirs}->{_pre_mswin}=
$self->{_work_dirs}->{_cwd_mswin};
$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';
}
} elsif ($self->{_uname} eq 'cygwin' &&
$target_dir=~/^[A-Za-z]:/) {
my ($drive,$path)=unpack('a1 x1 a*',$target_dir);
$path=~tr/\\/\//;
my $tar_dir=$self->{_cygdrive}.'/'.lc($drive).$path;
($output,$stderr)=$self->cmd("cd \"$tar_dir\"");
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr) {
if (wantarray) {
return $output,$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
if ($self->{_ftp_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftp_type =>$self->{_ftp_type} },
"cd \"$tar_dir\"",$cache);
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
}
#$self->{_work_dirs}->{_pre}=$self->{_work_dirs}->{_cwd};
#$self->{_work_dirs}->{_pre_mswin}=
# $self->{_work_dirs}->{_cwd_mswin};
#$self->{_work_dirs}->{_cwd}=$tar_dir.'/';
#$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';
} else {
if (1<$len_tdir && unpack('a2',$target_dir) eq '..') {
if ($self->{_ftp_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_ftp_type =>$self->{_ftp_type} },
'cd \'..\'',$cache);
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr) {
if (wantarray) { return '',$stderr }
else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4')
}
}
}
($output,$stderr)=$self->cmd('cd \'..\'');
$stderr=$output if -1<index $output,"Couldn't can";
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::LOG,'*';
print "WHAT IS EXISTS=",exists $self->{_cmd_handle}->{_work_dirs},"\n";
print $Net::FullAuto::FA_Core::LOG "WHAT IS EXISTS=",exists $self->{_cmd_handle}->{_work_dirs},"\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "WHAT IS REFNOW=",ref $self->{_cmd_handle}->{_work_dirs},"\n";
print $Net::FullAuto::FA_Core::LOG "WHAT IS REFNOW=",ref $self->{_cmd_handle}->{_work_dirs},"\n" if -1<index $Net::FullAuto::FA_Core::LOG,'*';
};
if (exists $self->{_work_dirs}->{_cwd}) {
$target_dir=$self->{_work_dirs}->{_cwd}
="$self->{_work_dirs}->{_cwd}/$target_dir/";
} else {
$target_dir=$self->{_work_dirs}->{_cwd_mswin}
="$self->{_work_dirs}->{_cwd_mswin}\\$target_dir\\";
}
}
if ((exists $self->{_ftp_type}) &&
$self->{_ftp_type}=~/s*ftp/) {
($output,$stderr)=
&Rem_Command::ftpcmd($self,
"cd \"$target_dir\"",$cache);
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
$Net::FullAuto::FA_Core::ftpcwd{$self->{_ftp_handle}}{cd}
=$target_dir;
}
if (($self->{_connect} eq 'connect_host') ||
($self->{_connect} eq 'connect_secure') ||
($self->{_connect} eq 'connect_insecure') ||
($self->{_connect} eq 'connect_shell') ||
($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='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});
if ($cfh_error) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});
if ($cfh_error) {
print "CLEAN_FILE_HANDLE ERROR in handle->cwd() COMMAND for TARGET=$target_dir => $cfh_error\n";
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-3');
}
}
($output,$stderr)=$self->cmd("cd \'$target_dir\'");
$stderr=$output if -1<index $output,"Couldn't can";
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else {
$self->{_work_dirs}->{_pre}=$self->{_work_dirs}->{_cwd};
if (exists $self->{_work_dirs}->{_pre_mswin}) {
$self->{_work_dirs}->{_pre_mswin}
=$self->{_work_dirs}->{_cwd_mswin};
my $tdir='';
if (exists $Net::FullAuto::FA_Core::cygpathw{$target_dir}) {
$tdir=$Net::FullAuto::FA_Core::cygpathw{$target_dir};
} else {
($tdir,$stderr)=$self->cmd("cygpath -w \"$target_dir\"");
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-4');
}
}
$tdir=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$target_dir}=$tdir;
};
$self->{_work_dirs}->{_cwd_mswin}=$tdir.'\\\\';
}
$self->{_work_dirs}->{_cwd}=$target_dir.'/';
$output='CWD command successful'
}
}
}
};
if ($@) {
chomp($@);
if (-1<index $@,"Transfer Directory") {
if (wantarray) {
return '', $@;
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} else {
my $die=$@;
#$die=~s/\.$//s;
$die=~s/( line.*)[.]$/\n $1/s;
if ($hostlabel=~/Master/) {
$hostlabel='localhost';
}
$die.=" on Host $hostlabel\n";
my $cnt='';my $hnames='';
foreach my $host (@{$self->{_hostlabel}}) {
next if !$cnt++;
next if !$host;
$hnames.="\'$host\', ";
} substr($hnames,-2)='';
$die.=" (Host also has Labels - $hnames)\n"
if $hnames;
if (wantarray) {
return '', "$die";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif (wantarray) {
return @return;
} else {
return $return[0];
}
}
sub pwd
{
my ($self) = @_;
if ($self->{_work_dirs}->{_cwd}) {
return $self->{_work_dirs}->{_cwd};
} else {
my $pwd=join '',$self->{"_$self->{_ftp_type}_handle"}->cmd('pwd');
chomp $pwd;return $pwd;
}
}
sub tmp
{
my $self=$_[0];
my $path=$_[1];
$path||='';
my $token=$_[2];
$token||='';
my ($output,$stderr)=('','');
if ($token=~/[Ww_1]/ && $token!~/[UuXx]/) { $token=1 } else { $token=0 }
if ($path) {
if ($path=~/^[\/|\\]|[a-zA-Z]:/) {
&Net::FullAuto::FA_Core::handle_error(
"Path: $path\n Must NOT be Fully "
."Qualified\n "
."(Hint: Must not begin with Drive Letter, or UNC, or '/')"
."\n Example: path/to/tmp -Not- b:\\path\\to\\tmp"
."\n or \\\\computer\\share\\path"
."\n or /path/to/tmp");
}
$path=~tr/\\/\//;
}
my $tdir='tmp'.$self->{_cmd_pid}.'_'
.$Net::FullAuto::FA_Core::invoked[0].'_'
.$Net::FullAuto::FA_Core::increment++;
push @{$Net::FullAuto::FA_Core::tmp_files_dirs{$self->{_cmd_handle}}},
[ $self->{_work_dirs}->{_tmp},$tdir ];
my $return_path='';
if ($token) {
$path=~tr/\\/\//;
$path=~s/\//\\/g;
$path=~s/\\/\\\\/g;
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
($output,$stderr)=$self->cmd($Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m.$self->{_work_dirs}->{_tmp}.'/'.$tdir);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$return_path=$self->{_work_dirs}->{_tmp_mswin}
.$tdir.'\\'.$path;
} else {
$path=~tr/\\/\//;
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
($output,$stderr)=$self->cmd($Net::FullAuto::FA_Core::gbp->('mkdir').
'mkdir -p '.$m.$self->{_work_dirs}->{_tmp}.'/'.$tdir);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$return_path=$self->{_work_dirs}->{_tmp}.$tdir.'/'.$path;
} return $return_path, $self->{_work_dirs}->{_tmp}.$tdir;
}
sub diff
{
push @_, '_diff';
return &mirror(@_);
}
sub mirror
{
my $_diff=0;
if ($_[$#_] eq '_diff') {
pop @_;
$_diff=1;
}
my ($baseFH, %args) = @_;
unless (exists $baseFH->{_ftp_handle} ||
!$same_host_as_Master{$baseFH->{_hostlabel}}) {
my $die="The \"BaseHost =>\" Argument to &mirror()"
."\n -> \"$baseFH->{_hostlabel}->[0]\" "
." Does not have an embedded SFTP connection\n "
." -> Be sure to use &connect_host() when"
." creating a base\n host connection to"
." be used with &mirror() when base"
."\n host is not the localhost.";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
my $username=&Net::FullAuto::FA_Core::username();
my $dest_output='';my $base_output='';my $lsgnu=0;
my $num_of_levels='';my $mirrormap='';my $trantar='';
my $trandir='';my $chk_id='';my $local_transfer_dir='';
my $destFH={};my $bprxFH='';my $dprxFH='';
my $sub=(caller(1))[3];$sub=~s/\s*FA_Core::/&/;
my $caller='';my $cline='';my $mirror_output='';
my $debug_info='';$deploy_info='';my $dir='';
my $mirror_debug='';my $excluded='';
my $base_unzip_path='';my $dest_unzip_path='';
my $base_zip_path='';my $tarlistmpdir='';
my ($output,$stdout,$stderr)=('','','');
$args{ZipBDir}||='';
$args{ZipDDir}||='';
if (!exists $args{Cache} || !$args{Cache} && $main::cache) {
$args{Cache}=$main::cache;
}
$args{Cache}||='';
my $cache=$args{Cache};
print "WHAT IS CACHE=$cache\n" if $cache;
print "KEYS=",(join " | ",keys %{$cache}),"\n" if $cache;
#print $Net::FullAuto::FA_Core::LOG "CACHEEEEEEEEEEEEEEEEEEEEEEEEEE=",$cache->{'key'},"\n";
($caller,$cline)=(caller)[1,2];
if (ref $args{DestHost} eq 'ARRAY') {
@dhostlabels=@{$args{DestHost}};
} elsif (4<length $args{DestHost} && unpack('a5',$args{DestHost})
eq 'ARRAY') {
&Net::FullAuto::FA_Core::handle_error(
"quotes improperly surround destination hostlabel(s) arg");
} else { @dhostlabels=();push @dhostlabels, $args{DestHost} }
foreach my $dest_hlabel (@dhostlabels) {
unless (exists $Net::FullAuto::FA_Core::Hosts{$dest_hlabel}) {
my $die="The \"DestHost =>\" Argument to &mirror()"
."\n -> \"$dest_hlabel\" Called"
." from the User Defined Subroutine\n "
." -> $sub is NOT\n a Valid"
." Host Label in the \"subs\" Subroutine File"
."\n -> $caller line $cline.\n";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} else {
last;
}
}
my $bhostlabel=$baseFH->{_hostlabel}->[0];
my $dhostlabel=$dhostlabels[0];
my $base_fdr=$args{BaseFileOrDir} || $args{BaseDir} || $args{BaseFile};
my $verbose=(exists $args{Verbose} && $args{Verbose}) ? 1 : 0;
my $skip_empty_dirs=
(exists $args{SkipEmptyDirs} && $args{SkipEmptyDirs}) ? 1 : 0;
my $index_base_once=
(exists $args{IndexBaseOnce} && $args{IndexBaseOnce}) ? 1 : 0;
$base_fdr||='';
$base_fdr=~s/[\/|\\]*$//;
if (unpack('a1',$base_fdr) eq '~') {
($stdout,$stderr)=$baseFH->cmd('echo ~');
$base_fdr=~s/~/$stdout/s;
}
my $dest_fdr=$args{DestDir};
$dest_fdr||='';
$dest_fdr=~s/[\/|\\]*$//;
my ($bip,$bhostname,$buse,$bms_share,$bms_domain,
$bcmd_cnct,$bftr_cnct,$blogin_id,$bsu_id,$bchmod,
$bowner,$bgroup,$btimeout,$btransfer_dir,$buname,
$bping,$bpassword,$bproxy,$bidentityfile,$bspawn,
$blocal_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($bhostlabel,
$baseFH->{_connect});
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$btimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$btimeout) {
$btimeout=$timeout if !$btimeout;
}
my $bhost=($buse eq 'ip')?$bip:$bhostname;
$bms_share||='';$btransfer_dir||='';
my ($dip,$dhostname,$duse,$dms_share,$dms_domain,
$dcmd_cnct,$dftr_cnct,$dlogin_id,$dsu_id,$dchmod,
$downer,$dgroup,$dtimeout,$dtransfer_dir,$duname,
$dping,$dpassword,$dproxy,$didentityfile,$dspawn,
$dlocal_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($dhostlabel,
$destFH->{_connect});
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$dtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$dtimeout) {
$dtimeout=$timeout if !$dtimeout;
} my $do_dest_tmp_cwd=1;
if ($baseFH->{_uname} ne 'cygwin' &&
$baseFH->{_hostlabel}->[0] ne "__Master_${$}__") {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,'lcd .',$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
unless ($output) {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,'!pwd',$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
} else {
$local_transfer_dir=unpack('x20 a*',$output);
}
$local_transfer_dir.='/';
($output,$stderr)=$baseFH->cwd($base_fdr) if $base_fdr;
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{cd}=$base_fdr;
}
if ($baseFH->{_uname} eq 'cygwin') {
my $test_chr1='';my $test_chr2='';
if ($base_fdr) {
$test_chr1=unpack('a1',$base_fdr);
if (1<length $base_fdr) {
$test_chr2=unpack('a2',$base_fdr);
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
$dir=$base_fdr;
if ($base_fdr=~/$baseFH->{_cygdrive_regex}/) {
$dir=~s/$baseFH->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
($output,$stderr)=$baseFH->cwd($base_fdr);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');
}
} else { $stderr='' }
$baseFH->{_ftp_handle}||='';
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;
$do_dest_tmp_cwd=0;
} elsif ($bms_share) {
$dir="\\\\$bhost\\$bms_share";
$base_fdr=~tr/\//\\/;
$dir.=$base_fdr;
} else {
if (exists $Net::FullAuto::FA_Core::cygpathw{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathw{$dir};
} else {
($dir,$stderr)=$baseFH->cmd("cygpath -w \"$dir\"");
&handle_error($stderr,'-1') if $stderr;
$dir=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$dir}=$dir;
}
($output,$stderr)=$baseFH->cwd($base_fdr);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');
}
} else { $stderr='' }
if (exists $baseFH->{_ftp_handle} ||
!$same_host_as_Master{$baseFH->{_hostlabel}->[0]}) {
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;
}
$do_dest_tmp_cwd=0;
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\') {
$dir=$base_fdr;
} elsif ($test_chr2=~/^[a-zA-Z]:$/) {
$dir=$base_fdr;
($output,$stderr)=$baseFH->cwd($base_fdr);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');
}
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;
$do_dest_tmp_cwd=0;
} elsif ($test_chr1!~/\W/) {
$dir=$baseFH->{_work_dirs}->{_cwd}.$base_fdr;
($output,$stderr)=$baseFH->cwd($dir);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{cd}=$dir;
$do_dest_tmp_cwd=0;
} elsif ($test_chr1 ne '~') {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory (1) - $base_fdr CANNOT Be Located");
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
if ($baseFH->{_work_dirs}->{_cwd}=~
/$baseFH->{_cygdrive_regex}/) {
($dir=$baseFH->{_work_dirs}->{_cwd})=~
s/$baseFH->{_cygdrive_regex}//;
$dir=s/^(.)/$1:/;
$dir=~tr/\//\\/;
} else {
$dir=$baseFH->{_work_dirs}->{_cwd};
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
$dir=$test_chr1.':/';
} elsif ($test_chr1 eq '.') {
$dir=$baseFH->{_cwd};
} elsif ($test_chr1 ne '~') {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory (2) - $base_fdr CANNOT Be Located");
} my $cnt=0;
} else {
$dir=$baseFH->{_work_dirs}->{_cwd};
} my $cnt=0;
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__');
if ($stderr) {
my $die=$stderr;
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
deep_delete_data_hash($baseFH,'_bhash') if
exists $baseFH->{_bhash} && $baseFH->{_bhash};
$main::base_shortcut_info{$baseFH}=$dir
if $index_base_once;
if (exists $baseFH->{_unaltered_basehash} &&
$baseFH->{_unaltered_basehash}) {
if ($index_base_once) {
$baseFH->{_bhash}=make_deep_data_copy(
$baseFH->{_unaltered_basehash});
} else {
deep_delete_data_hash($baseFH,'_unaltered_basehash');
}
}
if (!$stderr && $base_output!~/bytes free\s*/s) {
delete $main::base_shortcut_info{$baseFH} if
exists $main::base_shortcut_info{$baseFH};
$base_output='';next unless $cnt++;
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$dir\"\n\n run"
." on the host $baseFH->{_hostlabel}->[0] FAILED\n";
&Net::FullAuto::FA_Core::handle_error($die);
} else { last }
}
} else { # cygwin
deep_delete_data_hash($baseFH,'_bhash') if
exists $baseFH->{_bhash} && $baseFH->{_bhash};
if (exists $baseFH->{_unaltered_basehash} &&
$baseFH->{_unaltered_basehash}) {
if ($index_base_once) {
$baseFH->{_bhash}=make_deep_data_copy(
$baseFH->{_unaltered_basehash});
} else {
deep_delete_data_hash($baseFH,'_unaltered_basehash');
}
}
} &Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
} elsif ($base_fdr) {
my $dir='';
if (unpack('a1',$base_fdr) ne '/' && $base_fdr!~/^\W/) {
$dir=$baseFH->{_work_dirs}->{_cwd}.$base_fdr;
} elsif (unpack('a1',$base_fdr) eq '/') {
$dir=$base_fdr;
} else {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory (3) - $base_fdr CANNOT Be Located");
}
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/';
} elsif (-e '/bin/unzip') {
$base_unzip_path='/bin/';
} elsif (-e '/usr/local/bin/unzip') {
$base_unzip_path='/usr/local/bin/';
}
if (-e '/usr/bin/zip') {
$base_zip_path='/usr/bin/';
} elsif (-e '/bin/zip') {
$base_zip_path='/bin/';
} elsif (-e '/usr/local/bin/zip') {
$base_zip_path='/usr/local/bin/';
}
($base_output,$stderr)=$baseFH->cmd(
"${base_unzip_path}unzip -l $dir/$args{BaseZip}");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
if ($args{ZipBDir}) {
my $bo='';
foreach my $ln (split "\n", $base_output) {
next if -1<index $ln,'Archive:';
next unless -1<index $ln,$args{ZipBDir};
$bo.=$ln."\n";
} chop $bo;
$base_output=$bo;
}
} else {
my $ls_path=$Net::FullAuto::FA_Core::gbp->('ls',$baseFH);
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls --version");
if (-1<index $base_output,'GNU') {
$lsgnu=1;
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs --block-size=1 \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
} else {
($base_output,$stderr)=
$baseFH->cmd("${ls_path}ls -lRFs \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
}
if ($stderr) {
my $die=$stderr;
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} elsif (unpack('x2a1',$base_output) eq 'l' ||
unpack('x4a1',$base_output) eq 'l') {
$dir=substr($base_output,(index $base_output,'-> .')+4);
$dir=~s/\/?$//;
$base_fdr=$dir;
if ($lsgnu) {
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs --block-size=1 \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__
."\n" if $stderr;
} else {
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__
."\n" if $stderr;
}
if ($stderr) {
my $die=$stderr;
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
}
}
deep_delete_data_hash($baseFH,'_bhash') if
exists $baseFH->{_bhash} && $baseFH->{_bhash};
$main::base_shortcut_info{$baseFH}=$dir
if $index_base_once;
if (exists $baseFH->{_unaltered_basehash} &&
$baseFH->{_unaltered_basehash}) {
if ($index_base_once) {
$baseFH->{_bhash}=make_deep_data_copy(
$baseFH->{_unaltered_basehash});
} else {
deep_delete_data_hash($baseFH,'_unaltered_basehash');
}
}
} elsif (!exists $main::base_shortcut_info{$baseFH} ||
$main::base_shortcut_info{$baseFH} ne $dir ||
!$index_base_once) {
my $dir=$baseFH->{_work_dirs}->{_cwd};
$main::base_shortcut_info{$baseFH}=$dir if $index_base_once;
my $ls_path=$Net::FullAuto::FA_Core::gbp->('ls',$baseFH);
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls --version");
if (-1<index $base_output,'GNU') {
$lsgnu=1;
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
} else {
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls -lRs \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
}
deep_delete_data_hash($baseFH,'_bhash') if
exists $baseFH->{_bhash} && $baseFH->{_bhash};
$main::base_shortcut_info{$baseFH}=$dir
if $index_base_once;
if (exists $baseFH->{_unaltered_basehash} &&
$baseFH->{_unaltered_basehash}) {
if ($index_base_once) {
$baseFH->{_bhash}=make_deep_data_copy(
$baseFH->{_unaltered_basehash});
} else {
deep_delete_data_hash($baseFH,'_unaltered_basehash');
}
}
} else {
deep_delete_data_hash($baseFH,'_bhash');
$baseFH->{_bhash}=make_deep_data_copy(
$baseFH->{_unaltered_basehash});
}
if ($stderr) {
if (unpack('a10',$stderr) eq 'The System') {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr) }
} else {
my $die="The System $bhostlabel Returned\n "
." the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]
." line ".(caller(0))[2]." :\n\n $stderr";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
my $mdh=0;
my $timehash={};
if (!$baseFH->{_bhash}) {
my $hostlabel='';
eval {
my $ignore='';
($ignore,$stderr)=&build_base_dest_hashes(
$base_fdr,\$base_output,$args{Directives},
$bhost,$bms_share,$bms_domain,$baseFH->{_uname},
$baseFH,'BASE',$lsgnu,$args{ZipBDir},$cache);
if ($stderr) {
if ($stderr eq 'redo ls') {
while (1) {
my $err='';
my $ls_path=$Net::FullAuto::FA_Core::gbp->('ls',$baseFH);
if ($lsgnu) {
($base_output,$err)=$_[7]->cmd(
"${ls_path}ls -lRs --block-size=1 \'$_[0]\'");
} else {
($base_output,$err)=$_[7]->cmd(
"${ls_path}ls -lRs \'$_[0]\'");
}
&Net::FullAuto::FA_Core::handle_error($err,'-3') if $err;
($ignore,$stderr)=&build_base_dest_hashes(
$base_fdr,\$base_output,$args{Directives},
$bhost,$bms_share,$bms_domain,
$baseFH->{_uname},$baseFH,'BASE',
$lsgnu,$args{ZipBDir},$cache);
next if $stderr eq 'redo ls';
last;
}
} else {
$hostlabel=$bhostlabel;
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__');
}
}
};
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','',"$@";
} else {
my $die="The System $hostlabel Returned\n "
." the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]
." line ".(caller(0))[2]." :\n\n $@";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
return '','','',$die;
}
}
## CREATING UNALTERED BASE HIGH
$baseFH->{_unaltered_basehash}={};
foreach my $key (keys %{$baseFH->{_bhash}}) {
if (ref $baseFH->{_bhash}->{$key} eq 'ARRAY') {
foreach my $elem (@{$baseFH->{_bhash}->{$key}}) {
if (ref $elem ne 'HASH') {
push @{$baseFH->{_unaltered_basehash}->{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{$elem->{$key}}];
}
push @{$baseFH->{_unaltered_basehash}->{$key}}, \%newelem;
}
}
} else {
$baseFH->{_unaltered_basehash}->{$key}=$baseFH->{_bhash}->{$key};
}
}
}
foreach my $dhostlabel (@dhostlabels) {
my $activity=0;
%Net::FullAuto::FA_Core::file_rename=();
%Net::FullAuto::FA_Core::rename_file=();
($dip,$dhostname,$duse,$dms_share,$dms_domain,
$dcmd_cnct,$dftr_cnct,$dlogin_id,$dsu_id,$dchmod,
$downer,$dgroup,$dtimeout,$dtransfer_dir,$duname,
$dping,$dpassword,$dproxy,$didentityfile,$dspawn,
$dlocal_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($dhostlabel);
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$dtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$dtimeout) {
$dtimeout=$timeout if !$dtimeout;
}
##=======================================
## DOES DESTHOST CONNECTION EXIST?
##=======================================
if ((($dip eq $Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'IP'}) ||
($dhostname eq $Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'HostName'})) && !exists
$Net::FullAuto::FA_Core::Hosts{$dhostlabel}{
'sshport'}) {
$dhostlabel="__Master_${$}__";
$destFH=$Net::FullAuto::FA_Core::localhost;
($output,$stderr)=$destFH->cwd($destFH->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} else {
if ($dsu_id) { $chk_id=$dsu_id }
elsif ($dlogin_id) { $chk_id=$dlogin_id }
else { $chk_id=$username }
if (exists $Net::FullAuto::FA_Core::Connections{
"${dhostlabel}__%-$chk_id"}) {
$destFH=$Net::FullAuto::FA_Core::Connections{
"${dhostlabel}__%-$chk_id"};
if ($destFH->{_uname} ne $baseFH->{_uname} ||
$do_dest_tmp_cwd) {
if (defined $destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=$destFH->cwd(
$destFH->{_work_dirs}->{_tmp}||
$destFH->{_work_dirs}->{_tmp_mswin});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
} else {
if (exists $args{DestTimeout}) {
$dtimeout=$args{DestTimeout};
}
($destFH,$stderr)=&Net::FullAuto::FA_Core::connect_host(
$dhostlabel,$dtimeout);
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
}
}
$dms_share||='';
$dtransfer_dir||='';
my $dest_dir='';
my $dhost=($duse eq 'ip')?$dip:$dhostname;
my $die="The System $dhost Returned"
."\n the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n ";
my $err='';
($dest_output,$dest_dir,$err)=get_dest_ls_output(
$destFH,$dest_fdr,$dms_share,$dhost,$die);
if ($err) {
if (wantarray) {
return '',$err;
} else { &Net::FullAuto::FA_Core::handle_error($err,'-7'); }
}
if (ref $dest_first_hash eq 'HASH') {
deep_delete_data_hash($destFH,'_dhash');
}
my $hostlabel='';
eval {
my $ignore='';
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',
$lsgnu,$args{ZipDDir},$cache);
if ($stderr) {
if ($stderr eq 'redo ls' ||
$stderr=~/does not exist/s) {
while (1) {
my $dest_output='';my $err='';
my $ls_path=$Net::FullAuto::FA_Core::gbp->('ls',$destFH);
if ($lsgnu) {
($dest_output,$err)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_fdr\'");
} else {
($dest_output,$err)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_fdr\'");
}
&Net::FullAuto::FA_Core::handle_error($err,'-3') if $err;
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',
$lsgnu,$args{ZipDDir},$cache);
next if $stderr eq 'redo ls';
last;
}
} else {
$hostlabel=$dhostlabel;
&Net::FullAuto::FA_Core::handle_error($stderr,'-3');
}
}
};
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','',"$@";
} else {
my $die="The System $hostlabel Returned\n "
." the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]
." line ".(caller(0))[2]." :\n\n $@";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return '','','',$die;
}
}
my $newborn_dest_first_hash_flag=0;
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};
next;
}
my $elems=($#{$dest_first_hash->{$key}})+1;
while (-1<--$elems) {
if (ref $dest_first_hash->{$key}[$elems] ne 'HASH') {
undef $dest_first_hash->{$key}[$elems];
} 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}};
} delete $dest_first_hash->{$key}[$elems]->{$key};
} undef %{$dest_first_hash->{$key}[$elems]};
undef $dest_first_hash->{$key}[$elems];
}
} undef $dest_first_hash->{$key};
delete $dest_first_hash->{$key};
} undef %{$dest_first_hash};
}
## BUILDING FIRST DEST HASH
$dest_first_hash={};$newborn_dest_first_hash_flag=1;
foreach my $key (keys %{$destFH->{_dhash}}) {
if (ref ${$destFH->{_dhash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$destFH->{_dhash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$dest_first_hash}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
if (${${$elem}{$key}}[0] ne 'EXCLUDE') {
$newelem{$key}=[@{${$elem}{$key}}];
}
}
push @{${$dest_first_hash}{$key}}, \%newelem;
}
}
} else {
${$dest_first_hash}{$key}=${$destFH->{_dhash}}{$key};
}
}
my $shortcut=1;
if (!$newborn_dest_first_hash_flag) {
my $fdh=0;
TK: foreach my $key (keys %{$destFH->{_dhash}}) {
$fdh=1;
#print "SEARCHINGKEY=$key and VALUE=${$dest_first_hash}{$key}<==\n";
if (exists ${$dest_first_hash}{$key}) {
my %firstscalelems=();
my %firsthashelems=();
#print "MAKING NEW FIRSTHASHELEMS and ALL=",@{${$dest_first_hash}{$key}},"\n";
foreach my $felem (@{${$dest_first_hash}{$key}}) {
#print "ARE ALL FELEMS HASHES=$felem<==\n";
if ($felem eq 'EXCLUDE') {
delete ${$dest_first_hash}{$key};
next TK;
}
if (ref $felem ne 'HASH') {
#delete ${$dest_first_hash}{$key};
$firstscalelems{$felem}='-';
next;
}
#print "KEYSSSSBABYYYY=",keys %{${${$dest_first_hash}{$key}}[1]},"<==\n";
#<STDIN>;
foreach my $key (keys %{$felem}) {
#print "POPULATINGFIRST KEY=$key and VALUE=@{${$felem}{$key}}\n";
$firsthashelems{$key}=${$felem}{$key};
}
} my $elemnum=-1;
foreach my $elem (@{${$destFH->{_dhash}}{$key}}) {
if ($elem eq 'EXCLUDE') {
delete ${$dest_first_hash}{$key};
next TK;
}
if (ref $elem ne 'HASH') {
if (!exists $firstscalelems{$elem}) {
#print "DEST SUBVALUE=$elem DOES NOT EXIST IN FIRST\n";
#print "SETTING SHORTCUT TO ZERO 1\n";<STDIN>;
$shortcut=0;last;
}
} else {
#print "PARENTKEY=$key\n";
#print "ELEMSKEYSSSSSSSSSSSSSSSS=",keys %{$elem},"<==\n";
#print "FIRSTHASHSSSSSSSSSSSSSSSS=",keys %firsthashelems,"<==\n";
if (keys %{$elem}) {
if (keys %firsthashelems) {
foreach my $elm (keys %{$elem}) {
if (!exists $firsthashelems{$elm}) {
#print "0_DEST SUBHASHKEY=$elm DOES NOT EXIST IN FIRST and DIR=$key\n";
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($elm,$key)
if $Net::FullAuto::FA_Core::f_sub;
if ($return &&
(-1<index $returned_modif,'e')) {
delete
${${$destFH->{_dhash}}{$key}}[$elemnum];
next TK;
}
#print "SETTING SHORTCUT TO ZERO 2\n";
$shortcut=0;last;
} else {
my $arr1=join '',@{${$elem}{$elm}};
my $arr2=join '',@{$firsthashelems{$elm}};
if ($arr1 ne $arr2) {
my ($mn1,$dy1,$hr1,$mt1,$yr1,$sz1)=
split ' ',$arr1;
my ($mn2,$dy2,$hr2,$mt2,$yr2,$sz2)=
split ' ',$arr2;
if ($sz1==$sz2) {
my $testnum='';
if ($hr1<$hr2) {
$testnum=$hr2-$hr1;
} else { $testnum=$hr1-$hr2 }
if ($testnum==1 || ($hr1==23
&& ($testnum==12 ||
$testnum==11)) ||
("$mn1$dy1" eq "$mn2$dy2"
&& (($hr1 eq '12' &&
$mt1 eq '00') ||
($hr2 eq '12' &&
$mt2 eq '00')))) {
delete ${$dest_first_hash}{$key};
next TK;
}
}
#print "0_ELEM VALUE=",$arr1,"<== DOES NOT EXIST IN FIRST\n";
#print "OKAY WHAT THE HECK IS THE ELEM VALUE=",$arr1,"<==\n";
#print "OKAY WHAT THE HECK IS THE FVALUE=",$arr2,"<==\n";#<STDIN>;
#print "SETTING SHORTCUT TO ZERO 3\n";sleep 3;
$shortcut=0;last;
}
}
} last if !$shortcut;
} else {
#print "0_ELEM BUT NOT FIRST\n";
#print "SETTING SHORTCUT TO ZERO 4\n";<STDIN>;
$shortcut=0;last;
}
} elsif (keys %firsthashelems) {
#print "0_FIRSTHASHELEMS=",keys %firsthashelems,"\n";
#print "SETTING SHORTCUT TO ZERO 5\n";<STDIN>;
$shortcut=0;last;
}
}
} last if !$shortcut;
} else {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key)
if $Net::FullAuto::FA_Core::d_sub;
if ($return &&
-1<index $returned_modif,'e') {
delete
${$destFH->{_dhash}}{$key};
next TK;
} else { $shortcut=0;
#print "0_DEST KEY=$key DOES NOT EXIST IN FIRST\n";
#print "SETTING SHORTCUT TO ZERO 6\n";sleep 6;
}
} last if !$shortcut;
} $dest_first_hash={} if !$fdh;
} else {
## BUILDING FIRST BASE HASH
$baseFH->{_first_hash}={};
foreach my $key (keys %{$baseFH->{_bhash}}) {
#print "DO WE HAVE A KEY=$key<==\n";<STDIN>;
if (ref ${$baseFH->{_bhash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_bhash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_first_hash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_first_hash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_first_hash}}{$key}=[ ${$baseFH->{_bhash}}{$key} ];
}
}
%Net::FullAuto::FA_Core::renamefile=
%Net::FullAuto::FA_Core::rename_file;
$shortcut=0;
}
#print "WHAT IS SHORTCUT AFTER LOOKING AT FIRSTDESTHASH=$shortcut\n";sleep 5;
if ($shortcut) {
foreach my $key (keys %{$baseFH->{_bhash}}) {
if (ref ${$baseFH->{_bhash}}{$key} ne 'ARRAY') {
delete ${$baseFH->{_bhash}}{$key};
next;
}
my $elems=$#{${$baseFH->{_bhash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$baseFH->{_bhash}}{$key}[$elems] ne 'HASH') {
undef ${$baseFH->{_bhash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$baseFH->{_bhash}}{$key}[$elems]}) {
if (${${$baseFH->{_bhash}}{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_bhash}}{$key}[$elems]}{$key}};
} delete ${${$baseFH->{_bhash}}{$key}[$elems]}{$key};
} undef %{${$baseFH->{_bhash}}{$key}[$elems]};
undef ${$baseFH->{_bhash}}{$key}[$elems];
}
} undef ${$baseFH->{_bhash}}{$key};
delete ${$baseFH->{_bhash}}{$key};
} undef %{$baseFH->{_bhash}};$baseFH->{_bhash}={};
foreach my $key (keys %{$baseFH->{_first_hash}}) {
if (ref ${$baseFH->{_first_hash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_first_hash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_bhash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_bhash}}{$key}=${$baseFH->{_first_hash}}{$key};
}
}
foreach my $key (keys %{$destFH->{_dhash}}) {
my $elems=$#{${$destFH->{_dhash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$destFH->{_dhash}}{$key}[$elems] ne 'HASH') {
undef ${$destFH->{_dhash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$destFH->{_dhash}}{$key}[$elems]}) {
if (${${$destFH->{_dhash}}{$key}[$elems]}{$key}) {
undef @{${${$destFH->{_dhash}}{$key}[$elems]}{$key}};
} delete ${${$destFH->{_dhash}}{$key}[$elems]}{$key};
} undef %{${$destFH->{_dhash}}{$key}[$elems]};
undef ${$destFH->{_dhash}}{$key}[$elems];
}
} undef ${$destFH->{_dhash}}{$key};
delete ${$destFH->{_dhash}}{$key};
} undef %{$destFH->{_dhash}};$destFH->{_dhash}={};
foreach my $key (keys %{$dest_first_hash}) {
if (ref ${$dest_first_hash}{$key} eq 'ARRAY') {
foreach my $elem (@{${$dest_first_hash}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$destFH->{_dhash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$destFH->{_dhash}}{$key}}, \%newelem;
}
}
} else {
${$destFH->{_dhash}}{$key}=${$dest_first_hash}{$key};
}
}
}
$dest_output='';$deploy_info='';
($baseFH,$destFH,$timehash,$deploy_info,$debug_info)
=&build_mirror_hashes($baseFH,$destFH,$bhostlabel,
$dhostlabel,$verbose,$cache);
$bhostlabel="localhost - $Net::FullAuto::FA_Core::local_hostname"
if -1<index $bhostlabel,'__Mas';
$dhostlabel="localhost - $Net::FullAuto::FA_Core::local_hostname"
if -1<index $dhostlabel,'__Mas';
my $dhostname=$destFH->{'_hostname'};
if ($dhostlabel!~/^localhost/) {
unless ($dhostname) {
$dhostname=$destFH->{'_ip'};
}
if ($dhostname) {
$dhostlabel.=" - $dhostname";
}
}
my $bhostname=$baseFH->{'_hostname'};
if ($bhostlabel!~/^localhost/) {
unless ($bhostname) {
$bhostname=$baseFH->{'_ip'};
}
if ($bhostname) {
$bhostlabel.=" - $bhostname";
}
}
$mirror_output.="\n### mirror() output for Base Host:"
." $bhostlabel\n and Destination Host:"
." $dhostlabel\n\n$deploy_info";
$mirror_debug.="\n### mirror() debug for Base Host:\n"
." $bhostlabel\n and Destination Host:"
." $dhostlabel\n\n$debug_info";
#print "WHAT IS THIS=",keys %{$baseFH},"\n";
#print "KEYSBASEHASH=",keys %{$baseFH->{_bhash}},"\n";
#print "KEYSDESTHASH=",keys %{$destFH->{_dhash}},"\n";
#print "KEYSTIMEHASH=",keys %{$timehash},"\n";
if (keys %{$baseFH->{_bhash}}) {
if ($baseFH->{_uname} ne 'cygwin' ||
$base_fdr!~/^[\/|\\][\/|\\]/ ||
!$bms_share || !$#{$baseFH->{_hostlabel}}) {
my $base__dir=$base_fdr;
if ($base__dir!~/[^\/]\/$/ && $base__dir ne '/') {
$base__dir.='/';
}
my $bcurdir=$baseFH->{_work_dirs}->{_tmp};
my $aix_tar_input_variable_flag=0;
my $aix_tar_input_variable1='';
my $aix_tar_input_variable2='';
my $gnu_tar_input_file_flag=0;
my $gnu_tar_input_file1='';
my $gnu_tar_input_file2='';
my $gnu_tar_input_list1='';
my $gnu_tar_input_list2='';
my $solaris_tar_input_variable_flag=0;
my $solaris_tar_input_variable1='';
my $solaris_tar_input_variable2='';
my @dirt=();my $tmp_dir='';
if ($baseFH->{_uname} eq 'cygwin' &&
$destFH->{_uname} eq 'cygwin' &&
$dest_fdr=~/^[\/|\\][\/|\\]*/ &&
$dms_share && $#{$destFH->{_hostlabel}}) {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;my $ps='/';
$dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
my @basekeys=sort keys %{$baseFH->{_bhash}};
while (my $key=shift @basekeys) {
my @files=();
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (${$baseFH->{_bhash}}{$key}[1]
{$file}[0] ne 'EXCLUDE'
&& unpack('a4',
${$baseFH->{_bhash}}{$key}[1]
{$file}[0]) ne 'SAME') {
push @files, $file;
}
} my $tar_cmd='';my $save_dir='';
my $filearg='';my $farg='';
my $tdir='';my $filecount=0;my $fil_='';
foreach my $file (@files) {
$filecount++;
$file=~s/%/\\%/g;
if ($key eq '/') {
$farg.="\'$base__dir$file\' ";
$tdir=$dir;
} else {
$farg.="\'$base__dir$key/$file\' ";
my $tkey=$key;
$tkey=~tr/\//\\/ if ($ps ne '/');
$tdir="$dir$ps$tkey"
}
$fil_=$file;
if (1500 < length "cp -fpv $farg\'$tdir\'") {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
if ($stderr) {
&clean_process_files($destFH);
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir$ps$file\"");
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
} $filearg=$farg;
}
if ($filearg) {
if ($filecount==1) {
my $testd=&Net::FullAuto::FA_Core::test_dir(
$destFH,$tdir);
if ($testd) {
if ($testd eq 'READ') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir\"");
if ($stderr) {
my $die="Destination Directory $tdir\n"
.' is NOT Writable!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
} else {
#print "BE SURE TO ADD NEW CODE TO CHANGE BACK TO ",
# "MORE RESTRICTIVE PERMISSIONS\n";
}
} else {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
if ($stderr) {
&clean_process_files($destFH);
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir$ps$fil_\"");
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
}
} else {
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
($output,$stderr)=$destFH->cmd(
"cmd /c mkdir $m\"$tdir\"",'__live__');
#'__display__','__notrap__');
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
}
} else {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
if ($stderr) {
&clean_process_files($destFH);
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir/$fil_\"");
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
}
}
}
} else {
if (!$shortcut) {
if (0<$#dhostlabels && !$newborn_dest_first_hash_flag
&& !$Net::FullAuto::FA_Core::tranback && $activity) {
($output,$stderr)=$baseFH->cmd(
"cp ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ".
"${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3]_1.tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$Net::FullAuto::FA_Core::tranback=2;
} $activity=0;
my @basekeys=sort keys %{$baseFH->{_bhash}};
my $f_cnt=0;
($output,$stderr)=$baseFH->cmd("tar --help");
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE12 and TAROOUT=$output\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($stderr) {
if (-1<index $stderr,'-LInputList') {
$aix_tar_input_variable_flag=1;
} elsif (-1<index $stderr,'BDeEFhilmnopPqTvw') {
$solaris_tar_input_variable_flag=1;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
} elsif ($output) {
if (-1<index $output,'GNU' ||
-1<index $output,'-T, --files-from=NAME') {
$gnu_tar_input_file_flag=1;
}
}
#my $cppath='';
#my $diffpath='';
while (my $key=shift @basekeys) {
my @files=();
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (${$baseFH->{_bhash}}{$key}[1]
{$file}[0] ne 'EXCLUDE'
&& unpack('a4',
${$baseFH->{_bhash}}{$key}[1]
{$file}[0]) ne 'SAME') {
push @files, $file;
}
} my $tar_cmd='';my $save_dir='';my $zdir_flag=0;
foreach my $file (sort @files) {
print $Net::FullAuto::FA_Core::LOG "ACTIVITY2\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$activity=1;
my $base___dir='';
my $dir= ($key eq '/') ? '' : "$key/";
#print "WHAT IS DIR=$dir<== and KEY=$key\n";
if ($dir && $baseFH->{_uname} eq 'cygwin') {
if (exists $Net::FullAuto::FA_Core::cygpathu{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathu{$dir};
} else {
($dir,$stderr)=$baseFH->cmd(
"cygpath -u \"$dir\"");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
$Net::FullAuto::FA_Core::cygpathu{$dir}=$dir;
}
my $bcd='';
if (exists $Net::FullAuto::FA_Core::cygpathu{
$base_fdr}) {
$bcd=$Net::FullAuto::FA_Core::cygpathu{$base_fdr};
} else {
($bcd,$stderr)=$baseFH->cmd(
"cygpath -u \"$base_fdr\"");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
$Net::FullAuto::FA_Core::cygpathu{$base_fdr}=$bcd;
}
print $Net::FullAuto::FA_Core::LOG "ACTIVITY2 and DIR=$dir and BCD=$bcd\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$dir=~s/^(\/usr)*$bcd\/*//;
print $Net::FullAuto::FA_Core::LOG "ACTIVITY2AFTER and DIR=$dir and BASE__DIR=$base__dir<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
}
my $dirt='';
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE10\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (exists $Net::FullAuto::FA_Core::file_rename{
"$dir$file"}) {
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE9\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cmd="cp -Rpv \"$base__dir$dir$file\" "
."\"$bcurdir"
.$Net::FullAuto::FA_Core::file_rename{
"$dir$file"}."\"";
$file=$Net::FullAuto::FA_Core::file_rename{
"$dir$file"};
$base___dir=$bcurdir;
($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-2') if $stderr;
$dirt=substr($dir,0,(index $dir,'/'));
$dir='';
if ($gnu_tar_input_file_flag) {
($gnu_tar_input_file2,$tarlistmpdir)=
$baseFH->tmp(
'tarlist2.txt')
if !$gnu_tar_input_file2;
$gnu_tar_input_list2.="$file\n";
$tmp_dir=$bcurdir;
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE11 and FILE=$file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
push @dirt, $file;
} elsif ($aix_tar_input_variable_flag) {
$aix_tar_input_variable2.="${bcurdir}$file\n";
push @dirt, $file;
$tmp_dir=$bcurdir;
} elsif ($solaris_tar_input_variable_flag) {
$solaris_tar_input_variable2.="${bcurdir}$file\n";
push @dirt, $file;
$tmp_dir=$bcurdir;
} next
} else { $base___dir=$base__dir }
if ($_diff) {
if ($args{BaseZip}) {
if ($args{DestZip}) {
} else {
#print "ZIP=$args{BaseDir}/$args{BaseZip} and FILEEEE=$args{ZipBDir}/$dir$file<== and THIS=$baseFH->{_cwd}\n";
#my $env=$baseFH->cmd('env');
#print "WHAT IS ID=$env<== and $ENV{HOME}\n";<STDIN>;
($output,$stderr)=$baseFH->cmd(
"$base_unzip_path/unzip -o -d ".
"$baseFH->{_cwd}FA_Diff_Report_Zip ".
"$args{BaseDir}/$args{BaseZip} ".
"\"$args{ZipBDir}/$dir$file\"");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
if ($same_host_as_Master{$destFH->{_ip}}) {
#unless ($cppath) {
# if (-e '/usr/bin/cp') {
# $cppath='/usr/bin/';
# } elsif (-e '/bin/cp') {
# $cppath='/bin/';
# } elsif (-e '/usr/local/bin/cp') {
# $cppath='/usr/local/bin/';
# }
#}
#unless ($diffpath) {
# if (-e '/usr/bin/diff') {
# $diffpath='/usr/bin/';
# } elsif (-e '/bin/diff') {
# $diffpath='/bin/';
# } elsif (-e '/usr/local/bin/diff') {
# $diffpath='/usr/local/bin/';
# }
#}
($output,$stderr)=
$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->(
'cp',$baseFH)."cp -fp ".
"$args{DestDir}/$dir$file ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.dest");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=
$baseFH->cmd(
$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");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=
$baseFH->cmd("rm -rf ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.dest");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=
$baseFH->cmd("rm -rf ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
}
}
} elsif ($args{DESTZIP}) {
} else {
}
} elsif ($gnu_tar_input_file_flag) {
($gnu_tar_input_file1,$tarlistmpdir)=
$baseFH->tmp(
'tarlist1.txt')
if !$gnu_tar_input_file1;
$gnu_tar_input_list1.="$dir$file\n";
} elsif ($aix_tar_input_variable1) {
$aix_tar_input_variable1.="$dir$file\n";
} elsif ($solaris_tar_input_variable1) {
$solaris_tar_input_variable1.="$dir$file\n";
} else {
my $tar_cmd='';
if (!$f_cnt) {
$f_cnt++;
$tar_cmd=
"tar cvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
} else {
$tar_cmd=
"tar rvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
}
$tar_cmd.="-C \"$base___dir\" \"$dir$file\"";
${${$baseFH->{_bhash}}{$key}[1]{$file}}[0]
=~s/\s*$//;
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";
$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 $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
($output,$stderr)=$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->('tar',$baseFH).
$tar_cmd,500);
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr &&
$stderr!~/\[A(?:\[C)+\[K1/;
if ($dirt) {
my $cmd="rm -rf \"$base___dir/$dirt\"";
($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1
if $stderr;
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-2') if $stderr;
}
}
} @files=();
if (!$activity && !$skip_empty_dirs && $key ne '/'
&& ${$baseFH->{_bhash}}{$key}[0] eq 'ALL') {
# this block handles empty directories
$activity=1;
#unless ($cppath) {
# if (-e '/usr/bin/cp') {
# $cppath='/usr/bin/';
# } elsif (-e '/bin/cp') {
# $cppath='/bin/';
# } elsif (-e '/usr/local/bin/cp') {
# $cppath='/usr/local/bin/';
# }
#}
if (0) {
#if ($^O eq 'cygwin') {
if (exists
$Net::FullAuto::FA_Core::cygpathw{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathw{$dir};
} else {
my $cdr='';
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w \"$dir\"");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$dir}=$cdr;
$dir=$cdr;
}
}
if ($^O eq 'cygwin' && (-1<index $dir,'\\')) {
my $cdr='';
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath \"$dir\"");
&handle_error($stderr,'-1') if $stderr;
$dir=$cdr;
}
($output,$stderr)=$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->('cp',$baseFH).
"cp -Rfp $dir/$key $bcurdir");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
my $tar_cmd='';
if (!$f_cnt) {
$f_cnt++;
$tar_cmd=
"tar cvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
} else {
$tar_cmd=
"tar rvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
}
$tar_cmd.="-C \"$bcurdir\" \"$key\"";
($output,$stderr)=$baseFH->cmd(
$Net::FullAuto::FA_Core::gbp->('tar',$baseFH).
$tar_cmd);
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr &&
$stderr!~/\[A(?:\[C)+\[K1/;
($output,$stderr)=$baseFH->cmd(
"rm -rf ${bcurdir}$key");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
} elsif ($Net::FullAuto::FA_Core::tranback==2 && $activity) {
($output,$stderr)=$baseFH->cmd(
"cp ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3]_1.tar ".
"${bcurdir}transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$Net::FullAuto::FA_Core::tranback=1;$activity=0;
} else { $activity=0 }
}
if ($_diff) {
my $curdir=$baseFH->{_cwd};
($output,$stderr)=$baseFH->cwd(
"$baseFH->{_cwd}FA_Diff_Report_Zip");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=$baseFH->cmd(
"$base_zip_path/zip -r ".
"fa_diff_report *");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=$baseFH->cmd(
"mv fa_diff_report.zip ..");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=$baseFH->cmd(
"rm -rf $curdir/FA_Diff_Report_Zip");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=$baseFH->cmd(
"chown $username $curdir/fa_diff_report.zip");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
} else {
if ($activity) {
if ($gnu_tar_input_list1) {
chomp $gnu_tar_input_list1;
my @files=split /^/, $gnu_tar_input_list1;
my $filearg='';my $farg='';
foreach my $fil (@files) {
$fil=~s/%/\\%/g;
$farg.=$fil;
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE20 =$farg<= and $filearg<=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (1601 < length
"echo \"$farg\" >> \$gnu_tar_input_file1") {
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file1");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$farg=$fil;
} $filearg=$farg;
}
if ($filearg) {
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE21 =$filearg<=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file1");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
my $tar_cmd=
"tar cvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
$tar_cmd.="-C \"$base__dir\" -T \"$gnu_tar_input_file1\"";
($output,$stderr)=$baseFH->cmd($tar_cmd,'__display__');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
if ($gnu_tar_input_list2) {
chomp $gnu_tar_input_list2;
my @files=split /^/, $gnu_tar_input_list2;
my $filearg='';my $farg='';
foreach my $fil (@files) {
$fil=~s/%/\\%/g;
$farg.=$fil;
if (1601 < length
"echo \"$farg\" >> \$gnu_tar_input_file2") {
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file2");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$farg=$fil;
} $filearg=$farg;
}
if ($filearg) {
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file2");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
my $tar_cmd=
"tar rvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
$tar_cmd.="-C \"$tmp_dir\" -T \"$gnu_tar_input_file2\"";
($output,$stderr)=$baseFH->cmd($tar_cmd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
foreach my $dirt (@dirt) {
my $cmd="rm -rf \"$tmp_dir/$dirt\"";
($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
}
} elsif ($aix_tar_input_variable1) {
} elsif ($solaris_tar_input_variable1) {
}
print $Net::FullAuto::FA_Core::LOG "ACTIVITY3" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$shortcut) {
($output,$stderr)=$baseFH->cmd(
"chmod -v 777 ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
}
&move_tarfile($baseFH,$btransfer_dir,$destFH,
$shortcut,$cache,$tarlistmpdir);
#print "BASEFH=$baseFH\n";
#print "DESTFH=$destFH\n";
#print "BMS_SHARE=$bms_share\n";
#print "DMS_SHARE=$dms_share\n";
#print "LOCALTRANSFERDIR=$local_transfer_dir\n";
#print "TRANTAR=$trantar\n";
#print "BHOSTLABEL=$bhostlabel\n";
#print "DHOSTLABEL=$dhostlabel\n";
if ($destFH->{_uname} eq 'cygwin' &&
$dest_fdr=~/^[\/|\\][\/|\\]/ &&
$dms_share && $#{$destFH->{_hostlabel}}) {
$trantar=move_files($baseFH,'/','',
$dest_fdr,
$destFH,$bms_share,
$dms_share,'DEPLOY_ALL',
$local_transfer_dir,'',
$bhostlabel,$dhostlabel,
'',$shortcut);
}
($dest_output,$dest_dir,$err)=get_dest_ls_output(
$destFH,$dest_fdr,$dms_share,$dhost,$die);
my $ignore='';
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',
$lsgnu,$args{ZipDDir},$cache);
($baseFH,$destFH,$timehash,$deploy_info,$debug_info)
=&build_mirror_hashes($baseFH,$destFH,
$bhostlabel,$dhostlabel,$verbose,$cache);
my @basekeys=sort keys %{$baseFH->{_bhash}};
while (my $key=shift @basekeys) {
my @files=();
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (-1<index ${$baseFH->{_bhash}}{$key}[1]{$file}[0],
'DIFF_TIME') {
my $ts=${$baseFH->{_bhash}}{$key}[1]{$file}[1];
if ((split ' ',$ts)[4]==0) {
$ts=~s/^(\d+ \d+ \d+ \d+ )0( \d+)$/$1$curyear$2/;
}
$ts=unpack('x12 a4',$ts).unpack('a2',$ts).
unpack('x3 a2',$ts).unpack('x6 a2',$ts).
unpack('x9 a2',$ts);
my $key_dir=($key ne '/') ? "/$key/" : '/';
($stdout,$stderr)=$destFH->cmd(
"touch -t $ts \"$dest_fdr$key_dir$file\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
}
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);
next if $return && -1<index $returned_modif,'e';
} $excluded=0;
if (exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;
next if $return && -1<index $returned_modif,'e';
if ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) && (!exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
${$baseFH->{_unaltered_basehash}}{$key}[1]{$file}||='';
#print "SHORTCUT=$shortcut and THISSS=",
# ${$baseFH->{_unaltered_basehash}}{$key}[1]{$file},"<== and KEY=$key and FILE=$file\n";#<STDIN>;
if ($key eq '/') {
$activity=1;
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (a) File ==> $file\n";
$mirror_debug.="DELETED (a) File ==> $file\n";
} else {
$mirror_output.="DELETED File ==> $file\n";
$mirror_debug.="DELETED File ==> $file\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (a) File ==> $file\n";
$cache->set($cache->{'key'},[0,
"DELETING (a) File ==> $file\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (a) File ==> $file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil=$file;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
} else {
$activity=1;
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (b) File ==> $key/$file\n";
$mirror_debug.=
"DELETED (b) File ==> $key/$file\n";
} else {
$mirror_output.=
"DELETED File ==> $key/$file\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (b) File ==> $file\n";
$cache->set($cache->{'key'},[0,
"DELETING (b) File ==> $file\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (b) File ==> $file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil="$key/$file";
$fil=~s/\//\\/g;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$activity=1;
$key="$dest_fdr/." if $key eq '/';
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (c) Directory ==> $key\n";
$mirror_debug.="DELETED (c) Directory ==> $key\n";
} else {
$mirror_output.="DELETED Directory ==> $key\n";
$mirror_debug.="DELETED Directory ==> $key\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (c) Directory ==> $key\n";
$cache->set($cache->{'key'},[0,
"DELETING (c) Directory ==> $key\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (c) Directory ==> $key\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $dir=$key;
$dir=~s/\//\\/g;
$dir=$destFH->{_work_dirs}->{_cwd_mswin}
.$dir;
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$dir\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$key\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
foreach my $key (keys %{$baseFH->{_bhash}}) {
if (defined ${$baseFH->{_bhash}}{$key}[3]
&& ${$baseFH->{_bhash}}{$key}[3] eq 'NOT_ON_DEST') {
($output,$stderr)=$destFH->cmd("mkdir -p $key");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
my $mode=
$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
($output,$stderr)=$destFH->cmd("chmod -Rv $mode $key");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$activity=1;
}
}
}
print $Net::FullAuto::FA_Core::LOG "WHAT THE HECK1 IS ACTIVITY=$activity\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $nodif="\n THERE ARE NO DIFFERENCES "
."BETWEEN THE BASE AND TARGET\n\n";
if ((!$activity) && ((!$Net::FullAuto::FA_Core::cron && $verbose)
|| $Net::FullAuto::FA_Core::debug)) {
print $nodif;
$cache->set($cache->{'key'},[0,$nodif])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG $nodif
if (!$activity) &&
$Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$mirror_output.=$nodif if !$activity;
$mirror_debug.=$nodif if !$activity;
push @main::test_tar_output, $mirror_output;
} else {
$activity=0;
if (${$baseFH->{_bhash}}{'/'}[0] eq 'ALL') {
print $Net::FullAuto::FA_Core::LOG "ACTIVITY7" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$activity=1;
$trantar=move_files($baseFH,'/','',
$dest_fdr,
$destFH,$bms_share,
$dms_share,'DEPLOY_ALL',
$local_transfer_dir,'',
$bhostlabel,$dhostlabel,
'',$shortcut);
} else {
#print "HERE WE ARE FFFFTOP and $#{[keys %{$baseFH->{_bhash}}]}\n";
#print $Net::FullAuto::FA_Core::LOG "WE ARE HERE FFFFTOP and ",
#"$#{[keys %{$baseFH->{_bhash}}]}\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my @basekeys=sort keys %{$baseFH->{_bhash}};my @files=();
while (my $key=shift @basekeys) {
#print "BASEKEYYYYYY=$key and ==>",${$baseFH->{_bhash}}{$key}[0],"<==\n";
if (${$baseFH->{_bhash}}{$key}[0] eq 'ALL' ||
${$baseFH->{_bhash}}{$key}[0] eq 'NOT_ON_DEST'
|| ${$baseFH->{_bhash}}{$key}[0] eq
'ALL_DIR_ON_DEST') {
#print "BASEFH=$baseFH\n";
#print "KEY=$key\n";
#print "DEST_FDR=$dest_fdr\n";
#print "DESTFH=$destFH\n";
#print "BMS_SHARE=$bms_share\n";
#print "DMS_SHARE=$dms_share\n";
#print "LOCAL=$local_transfer_dir\n";
#print "TRANTAR=$trantar\n";
#print "BHOSTLABEL=$bhostlabel\n";
#print "KEYYYYY=$key and DIREC=",${$baseFH->{_bhash}}{$key}[0],"\n";<STDIN>;
my $parentkey='';
if ($key ne '/') {
if (-1<index $key,'/') {
$parentkey=$key;
substr($parentkey,(rindex $parentkey,'/'))='';
next if exists ${$baseFH->{_bhash}}{$parentkey}[0]
&& ${$baseFH->{_bhash}}{$parentkey}[0] eq 'ALL';
$parentkey="\\$parentkey";
}
}
$trantar=move_files($baseFH,$key,'',
$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
$parentkey,$shortcut);
if ($basekeys[0] && (-1<index $basekeys[0],'/')) {
my $lkey=0;my $lbky=0;
$lkey=length $key;
$lbky=length $basekeys[0];
while ($lkey<=$lbky &&
unpack("a$lkey",$basekeys[0])
eq $key &&
(-1<index $basekeys[0],'/')) {
shift @basekeys;
}
} $activity=1;
print $Net::FullAuto::FA_Core::LOG "ACTIVITY8" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
next;
} elsif (${$baseFH->{_bhash}}{$key}[0] ne 'EXCLUDE'
&& ${$baseFH->{_bhash}}{$key}[2] ne
'DEPLOY_NOFILES_OF_CURDIR') {
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (${$baseFH->{_bhash}}{$key}[1]
{$file}[0] ne 'EXCLUDE'
&& unpack('a4',
${$baseFH->{_bhash}}{$key}[1]
{$file}[0]) ne 'SAME') {
push @files, $file;
}
}
$trantar=move_files($baseFH,$key,
\@files,$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
'',$shortcut);
$activity=1;
print $Net::FullAuto::FA_Core::LOG "ACTIVITY9" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
} elsif (${$baseFH->{_bhash}}{$key}[0] ne 'EXCLUDE') {
$trantar=move_files($baseFH,$key,
\@files,$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
')DIRONLY',$shortcut);
print $Net::FullAuto::FA_Core::LOG "ACTIVITY10" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$activity=1;
}
}
}
if ($activity && $trantar) {
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::file_rename) {
my $cmd=
"mv \"transfer$Net::FullAuto::FA_Core::tran[3]/$file\""
." \"transfer$Net::FullAuto::FA_Core::tran[3]/"
."$Net::FullAuto::FA_Core::file_rename{$file}\"";
my ($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
}
my $cmd="cmd /c tar -C "
."\'transfer$Net::FullAuto::FA_Core::tran[3]\' -cvf "
."\'transfer$Net::FullAuto::FA_Core::tran[3].tar\' .";
$cmd=~tr/\\/\//;
($output,$stderr)=$baseFH->cmd('pwd');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
print $Net::FullAuto::FA_Core::LOG "TARRRPWDDDDD=$output\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($output,$stderr)=$baseFH->cmd($cmd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
($output,$stderr)=$baseFH->cmd(
"cmd /c rmdir /s /q transfer".
"$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
if (&Net::FullAuto::FA_Core::test_dir(
$baseFH,
"transfer$Net::FullAuto::FA_Core::tran[3]")) {
($output,$stderr)=$baseFH->cmd(
"chmod -Rv 777 transfer".
"$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
($output,$stderr)=$baseFH->cmd(
"cmd /c rmdir /s /q transfer".
"$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
#print "DO MOVETARFILE\n";
&move_tarfile($baseFH,$btransfer_dir,$destFH,
$shortcut,$cache,$tarlistmpdir);
if (keys %{$timehash}) {
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
($output,$stderr)=$destFH->cmd("touch --version");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr &&
(-1==index $stderr,'Not a recog') &&
(-1==index $stderr,'illegal opt');
#print "TOUCHOUT=$output and STDERR=$stderr\n";
print $Net::FullAuto::FA_Core::LOG "TOUCHOUT=$output and STDERR=$stderr and EVAL=$@\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $touch='';
$touch='GNU' if -1<index $output,'GNU';
foreach my $file (keys %{$timehash}) {
my $time='';
$time=${${$timehash}{$file}}[1];
$time=~tr/ //d;
if ($touch eq 'GNU') {
$time="$time${${$timehash}{$file}}[0]";
} else {
$time="${${$timehash}{$file}}[0]$time";
}
#print "GOING TO TOUCH TIME=$time and FILE=$file\n";
print $Net::FullAuto::FA_Core::LOG "GOING TO TOUCH TIME=$time and FILE=$file\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($output,$stderr)=
$destFH->cmd('touch -t'." $time \"$file\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
#$Net::FullAuto::FA_Core::log=0 if $logreset;
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);
next if $return && -1<index $returned_modif,'e';
} $excluded=0;
if (!$shortcut && exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (
keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;
next if $return && -1<index $returned_modif,'e';
if ((exists $args{DeleteOnDest}
&& $args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (d) File ==> $file\n";
$mirror_debug.=
"DELETED (d) File ==> $file\n";
} else {
$mirror_output.=
"DELETED File ==> $file\n";
$mirror_debug.=
"DELETED File ==> $file\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (d) File ==> $file\n";
$cache->set($cache->{'key'},[0,
"DELETING (d) File ==> $file\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (d) File ==> $file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil=$file;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (e) File ==> $key/$file\n";
$mirror_debug.=
"DELETED (e) File ==> $key/$file\n";
} else {
$mirror_output.=
"DELETED File ==> $key/$file\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (e) File ==> $file\n";
$cache->set($cache->{'key'},[0,
"DELETING (e) File ==> $file\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (e) File ==> $file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil="$key/$file";
$fil=~s/\//\\/g;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$key="$dest_fdr/." if $key eq '/';
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (f) Directory ==> $key\n";
$mirror_debug.="DELETED (f) Directory ==> $key\n";
} else {
$mirror_output.="DELETED Directory ==> $key\n";
$mirror_debug.="DELETED Directory ==> $key\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (f) Directory ==> $key\n";
$cache->set($cache->{'key'},[0,
"DELETING (f) Directory ==> $key\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (f) Directory ==> $key\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $dir=$key;
$dir=~s/\//\\/g;
$dir=$destFH->{_work_dirs}->{_cwd_mswin}
.$dir;
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$dir\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$key\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
}
} elsif (!$activity) {
my $nodif='';my $excluded=0;
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);
next if $return && -1<index $returned_modif,'e';
} $excluded=0;
if (exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;
next if $return && -1<index $returned_modif,'e';
if ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (g) File ==> $file\n";
$mirror_debug.="DELETED (g) File ==> $file\n";
} else {
$mirror_output.="DELETED File ==> $file\n";
$mirror_debug.="DELETED File ==> $file\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (g) File ==> $file\n";
$cache->set($cache->{'key'},[0,
"DELETING (g) File ==> $file\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (g) File ==> $file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.=
"DELETED (h) File ==> $key/$file\n";
$mirror_debug.=
"DELETED (h) File ==> $key/$file\n";
} else {
$mirror_output.=
"DELETED File ==> $key/$file\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (h) File ==> $key/$file\n";
$cache->set($cache->{'key'},[0,
"DELETING (h) File ==> $key/$file\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (h) File ==> $key/$file\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$key="$dest_fdr/." if $key eq '/';
if ($Net::FullAuto::FA_Core::debug) {
$mirror_output.="DELETED (i) Directory ==> $key\n";
$mirror_debug.="DELETED (i) Directory ==> $key\n";
} else {
$mirror_output.="DELETED Directory ==> $key\n";
$mirror_debug.="DELETED Directory ==> $key\n";
}
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug) {
print "DELETING (i) Directory ==> $key\n";
$cache->set($cache->{'key'},[0,
"DELETING (i) Directory ==> $key\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"DELETING (i) Directory ==> $key\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($output,$stderr)=
$destFH->cmd("rm -rf $key");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
print $Net::FullAuto::FA_Core::LOG "WHAT THE HECK2 IS ACTIVITY=$activity\n"
if defined $Net::FullAuto::FA_Core::LOG;
$nodif="\n THERE ARE NO DIFFERENCES "
."BETWEEN THE BASE AND TARGET\n\n";
if ((!$activity) && ((!$Net::FullAuto::FA_Core::cron && $verbose)
|| $Net::FullAuto::FA_Core::debug)) {
print $nodif;
$cache->set($cache->{'key'},[0,$nodif])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG $nodif
if (!$activity) &&
$Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$mirror_output.=$nodif if !$activity;
$mirror_debug.=$nodif if !$activity;
push @main::test_tar_output, $mirror_output;
}
}
}
}
if (exists $destFH->{_work_dirs}->{_pre} && $destFH->{_work_dirs}->{_pre}
&& $destFH->{_work_dirs}->{_pre} ne $destFH->{_work_dirs}->{_cwd}
&& $destFH->{_work_dirs}->{_pre} ne $destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=$destFH->cwd($destFH->{_work_dirs}->{_pre});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
if (wantarray) {
return $mirror_output,$mirror_debug;
} else { return $mirror_output }
}
sub make_deep_data_copy
{
my $deep_data=$_[0];
my $new_copy={};
foreach my $key (keys %{$deep_data}) {
if (ref $deep_data->{$key} eq 'ARRAY') {
foreach my $elem (@{$deep_data->{$key}}) {
if (ref $elem ne 'HASH') {
push @{$new_copy->{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{$elem->{$key}}];
}
push @{$new_copy->{$key}}, \%newelem;
}
}
} else {
$new_copy->{$key}=$deep_data->{$key};
}
}
return $new_copy;
}
sub deep_delete_data_hash
{
my $dataFH=$_[0];
my $hash=$_[1];
foreach my $key (keys %{$dataFH->{$hash}}) {
if (ref $dataFH->{$hash}->{$key} ne 'ARRAY') {
delete $dataFH->{$hash}->{$key};
next;
}
my $elems=($#{$dataFH->{$hash}->{$key}})+1;
while (-1<--$elems) {
if (ref $dataFH->{$hash}->{$key}[$elems] ne 'HASH') {
undef $dataFH->{$hash}->{$key}[$elems];
} else {
foreach my $key (
keys %{$dataFH->{$hash}->{$key}[$elems]}) {
if ($dataFH->{$hash}->{$key}[$elems]->{$key}) {
undef
@{$dataFH->{$hash}->{$key}[$elems]->{$key}};
} delete $dataFH->{$hash}->{$key}[$elems]->{$key};
} undef %{$dataFH->{$hash}->{$key}[$elems]};
undef $dataFH->{$hash}->{$key}[$elems];
}
} undef $dataFH->{$hash}->{$key};
delete $dataFH->{$hash}->{$key};
} undef %{$dataFH->{$hash}};undef $dataFH->{$hash};
}
sub get_drive
{
my @topcaller=caller;
print "get_drive() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "get_drive() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($folder,$base_or_dest,$cmd_handle,$hostlabel)=('','','','');
($folder,$base_or_dest,$cmd_handle,$hostlabel)=@_;
$cmd_handle||='';
my ($output,$stderr)=('','');
my @drvs=();my $dir='';
if (unpack('a1',$folder) eq '/' ||
unpack('a1',$folder) eq '\\') {
$dir=unpack('a1',$folder);
} else { $dir=$folder }
$dir=~tr/\\/\//;
my $ms_dir=$dir;
$ms_dir=~tr/\//\\/;
$ms_dir=~s/\\/\\\\/g;my $drvs='';
if (exists $Net::FullAuto::FA_Core::drives{$hostlabel}) {
$drvs=$Net::FullAuto::FA_Core::drives{$hostlabel};
} else {
my $sav_curdir='';
if ($cmd_handle) {
bless $cmd_handle, 'File_Transfer';
($sav_curdir,$stderr)=$cmd_handle->cmd('pwd');
&handle_error($stderr,'-1') if $stderr;
if (exists $Net::FullAuto::FA_Core::cygpathw{$sav_curdir}) {
$sav_curdir=$Net::FullAuto::FA_Core::cygpathw{$sav_curdir};
} else {
($sav_curdir,$stderr)=$cmd_handle->cmd(
"cygpath -w \"$sav_curdir\"");
&handle_error($stderr,'-1') if $stderr;
$sav_curdir=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$sav_curdir}=$sav_curdir;
}
($output,$stderr)=$cmd_handle->cwd($cmd_handle->{_cygdrive});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($drvs,$stderr)=$cmd_handle->cmd('ls');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} elsif ($^O eq 'cygwin') {
$sav_curdir=Cwd::getcwd();
chdir $Net::FullAuto::FA_Core::localhost->{_cygdrive};
$drvs=`ls`;
}
if ($cmd_handle) {
($output,$stderr)=$cmd_handle->cwd($sav_curdir);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} else { chdir $sav_curdir }
$Net::FullAuto::FA_Core::drives{$hostlabel}=$drvs;
}
foreach my $drv (split /\n/, $drvs) {
last unless $drv;
if ($cmd_handle) {
my $result=&Net::FullAuto::FA_Core::test_dir(
$cmd_handle,
$cmd_handle->{_cygdrive}."/$drv/$dir/");
if ($result ne 'NODIR') {
if ($ms_dir && $ms_dir ne '\\\\') {
push @drvs, "$drv:\\$ms_dir\\";
} else { push @drvs, "$drv:\\" }
}
} elsif (-d "$drv:\\$ms_dir") {
if ($ms_dir && $ms_dir ne '\\\\') {
push @drvs, "$drv:\\$ms_dir\\";
} else { push @drvs, "$drv:\\" }
}
}
if (-1<$#drvs) {
if ($#drvs==0) {
$dir=$drvs[0];
} else {
my $banner="\n Please Pick a $base_or_dest Directory\n"
." on the Local Host "
."$Net::FullAuto::FA_Core::Local_HostName :";
$dir=&Term::Menus::pick(\@drvs,$banner);
}
my ($drive,$path)=unpack('a1 x1 a*',$dir);
$path=~tr/\\/\//;
if ($cmd_handle) {
$folder=$cmd_handle->{_cygdrive}.'/'.lc($drive).$path.'/';
} else {
$folder=$Net::FullAuto::FA_Core::localhost->{_cygdrive}.'/'.
lc($drive).$path.'/';
}
} else {
my $die="Cannot Locate Directory $folder\n"
." Anywhere on Local $base_or_dest Host "
."$Net::FullAuto::FA_Core::Local_HostName\n";
&Net::FullAuto::FA_Core::handle_error($die);
}
if (wantarray) {
return $folder,$dir
} else { return $folder }
}
sub get_dest_ls_output {
my $destFH=$_[0];
my $dest_fdr=$_[1]||'';
my $dms_share=$_[2]||'';
my $dhost=$_[3]||'';
my $die=$_[4]||'';
my $dest_dir='';
my $dest_output='';
my $stderr='';my $lsgnu=0;
if ($destFH->{_uname} eq 'cygwin') {
my ($test_chr1,$test_chr2)='';
if ($dest_fdr) {
$test_chr1=unpack('a1',$dest_fdr);
if (1<length $dest_fdr) {
$test_chr2=unpack('a2',$dest_fdr);
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
$dest_dir=$dest_fdr;
if ($dest_dir=~s/$destFH->{_cygdrive_regex}//) {
$dest_dir=~s/^(.)/$1:/;
$dest_dir=~tr/\//\\/;
} else {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\') {
$dest_dir=$dest_fdr;
#print "NAKED\n";<STDIN>;
} elsif ($test_chr2=~/^[a-zA-Z]:$/) {
$dest_dir=$dest_fdr;
#print "NAKED\n";<STDIN>;
} elsif ($test_chr1!~/\W/) {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
} else {
my $die="Destination Directory (1) - $dest_fdr"
." CANNOT Be Located";
&Net::FullAuto::FA_Core::handle_error($die);
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
$dest_dir=$dest_fdr;
if ($dest_dir=~s/$destFH->{_cygdrive_regex}//) {
$dest_dir=~s/^(.)/$1:/;
$dest_dir=~tr/\//\\/;
#print "OLSKDKF\n";
} else {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
#print "WOOEEE\n";
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
#print "BLECKKK\n";
$dest_dir=$test_chr1 . ':\\';
} else {
my $die="Destination Directory (2) - $dest_fdr"
." CANNOT Be Located";
&Net::FullAuto::FA_Core::handle_error($die);
}
} else {
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin};
} my $cnt=0;
while (1) {
($dest_output,$stderr)=$destFH->cmd(
"cmd /c dir /s /-C /A- \"$dest_dir\"");
&Net::FullAuto::FA_Core::handle_error($stderr.
" when attempting command:\n\n".
" cmd /c dir /s /-C /A- \"$dest_dir\"",
'-1') if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
if ($dest_output!~/bytes free\s*/s) {
$dest_output='';next unless $cnt++;
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$dest_dir\"\n"
."\n run on the host "
."$destFH->{_hostlabel}->[0] FAILED";
&Net::FullAuto::FA_Core::handle_error($die,'-1');
} else { last }
}
} elsif ($dest_fdr) {
my $test_char=unpack('a1',$dest_fdr);
if ($test_char ne '/' && $test_char ne '.') {
$dest_dir=$destFH->{_work_dirs}->{_cwd}
.$dest_fdr;
} else {
$dest_dir=$dest_fdr;
}
my $ls_path=$Net::FullAuto::FA_Core::gbp->('ls',$destFH);
($dest_output,$stderr)=$destFH->cmd("${ls_path}ls --version");
if (-1<index $dest_output,'GNU') {
$lsgnu=1;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_dir\'");
} else {
$lsgnu=0;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_dir\'");
}
if ($stderr) {
print $Net::FullAuto::FA_Core::LOG "$die$stderr"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return '', '', "$die$stderr";
}
} else {
my $dest_dir=$destFH->{_work_dirs}->{_cwd};
my $ls_path=$Net::FullAuto::FA_Core::gbp->('ls',$destFH);
($dest_output,$stderr)=$destFH->cmd("${ls_path}ls --version");
if (-1<index $dest_output,'GNU') {
$lsgnu=1;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_dir\'");
} else {
$lsgnu=0;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_dir\'");
}
if ($stderr) {
print $Net::FullAuto::FA_Core::LOG "$die$stderr"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return '', '', "$die$stderr";
}
}
return $dest_output,$dest_dir,'';
}
sub move_tarfile
{
my @topcaller=caller;
print "move_tarfile() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "move_tarfile() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($baseFH,$btransfer_dir,$destFH,$shortcut,$cache,$tarlistmpdir)=
('','','','','','');
($baseFH,$btransfer_dir,$destFH,$shortcut,$cache,$tarlistmpdir)=@_;
my ($output,$stdout,$stderr)=('','','');
my $dest_fdr=$destFH->{_work_dirs}->{_cwd};
my $bprxFH='';my $dprxFH='';my $d_fdr='';
my $trandir_parent='';
my $phost= $baseFH->{_hostlabel}->[1]?
$baseFH->{_hostlabel}->[1]:
$baseFH->{_hostlabel}->[0];
unless ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
$baseFH->{_hostlabel}->[0] eq "__Master_${$}__") {
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__") {
if ($destFH->{_work_dirs}->{_tmp}) { # DEST-Master has trandir
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"lcd \"$destFH->{_work_dirs}->{_tmp}\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$destFH->{_ftp_handle}||='';
$d_fdr=$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}=
$destFH->{_work_dirs}->{_tmp};
} else {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"lcd \"$dest_fdr\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$d_fdr=$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}=
$dest_fdr;
}
if ($baseFH->{_work_dirs}->{_tmp}) { # If BASE has remote trandir
# cd ftp handle to it
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"cd $baseFH->{_work_dirs}->{_tmp}",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
} else {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"cd $baseFH->{_work_dirs}->{_cwd}",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
}
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
} elsif ($baseFH->{_hostlabel}->[0] eq "__Master_${$}__") {
if ($baseFH->{_work_dirs}->{_tmp} &&
exists $baseFH->{_ftp_handle}) {
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"lcd \"$baseFH->{_work_dirs}->{_tmp}\"",$cache);
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{lcd}=
$baseFH->{_work_dirs}->{_tmp};
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
}
if ($destFH->{_work_dirs}->{_tmp}) { # If DEST has trandir
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd \"$destFH->{_work_dirs}->{_tmp}\"",$cache);
# cd ftp handle to trandir
$d_fdr=$destFH->{_work_dirs}->{_tmp};
} else { # No trandir on DEST,
($output,$stderr)=&Rem_Command::ftpcmd( # use $dest_fdr for transfer
$destFH,"cd \"$dest_fdr\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}
=$d_fdr=$dest_fdr;
}
($output,$stderr)=&Rem_Command::ftpcmd( # Transfer the tar file
$destFH,"!id",$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 $Net::FullAuto::FA_Core::LOG
"move_tarfile() TRYING TO DO PUT (1)\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($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);
if (-1<index "$output","permissions do not") {
&Net::FullAuto::FA_Core::handle_error($output,'-1');
die "$output $!"
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
if ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(
$destFH, # lcd ftp handle back to parent
"lcd \"$baseFH->{_work_dirs}->{_tmp}\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}
=$baseFH->{_work_dirs}->{_tmp};
}
} elsif (&ftm_connect($destFH,$phost)) {
my %ftp=(
_ftp_handle => $destFH->{_cmd_handle},
_ftp_type => $destFH->{_ftp_type},
_hostname => $destFH->{_hostname},
_ip => $destFH->{_ip},
_uname => $destFH->{_uname},
_luname => $baseFH->{_uname},
_hostlabel => [ $destFH->{_hostlabel}->[0],$phost ],
_ftp_pid => $destFH->{_ftp_pid}
);
if ($destFH->{_uname} ne 'cygwin' ||
$dest_fdr!~/^[\/|\\][\/|\\]/ ||
!$destFH->{_ms_share} || !$#{$destFH->{_hostlabel}}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd \"$dest_fdr\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
#print "SAVING LCD PATH OF DEST2=transfer$Net::FullAuto::FA_Core::tran[3]\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{lcd}
=$d_fdr=$dest_fdr;
} else {
if ($destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd \"$destFH->{_work_dirs}->{_tmp}\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$d_fdr=$destFH->{_work_dirs}->{_tmp};
}
my $mode=$Net::FullAuto::FA_Core::cygwin_berkeley_db_mode;
my $m=($^O eq 'cygwin')?"-m $mode ":'';
$m='-m 777 ' if $^O ne 'cygwin' &&
$Net::FullAuto::FA_Core::fa_perm==365;
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"!mkdir ${m}transfer$Net::FullAuto::FA_Core::tran[3]",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$Net::FullAuto::FA_Core::tran[4]=1;
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd transfer$Net::FullAuto::FA_Core::tran[3]",$cache);
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{lcd}
="transfer$Net::FullAuto::FA_Core::tran[3]";
$d_fdr.="transfer$Net::FullAuto::FA_Core::tran[3]";
}
if ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$baseFH->{_work_dirs}->{_tmp}\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
my ($output,$stderr)=$baseFH->cwd(
$baseFH->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
=$baseFH->{_work_dirs}->{_tmp};
} else {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$baseFH->{_work_dirs}->{_cwd}\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
="$baseFH->{_work_dirs}->{_cwd}";
}
#print "GOING TO GET THE TAR AND BRING IT TO DESTTTTTTTTTTTTTTTTT\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
my $prompt = '_funkyPrompt_';
$destFH->{_cmd_handle}->prompt("/$prompt\$/");
$destFH->{_cmd_handle}->print('bye');
while (my $line=$destFH->{_cmd_handle}->get) {
#print "GETTING BACK THE CMD FROM FTP LINE=$line\n";
last if $line=~/_funkyPrompt_/s;
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
DH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($destFH->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
substr($type,0,3)='cmd';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last DH;
}
}
}
}
}
} else {
File::Copy::copy($destFH->{_work_dirs}->{_tmp}.
"transfer$Net::FullAuto::FA_Core::tran[3].tar",
$dest_fdr)
|| do{ die "copy failed: $!" };
$d_fdr=$dest_fdr;
}
if ($d_fdr eq $dest_fdr) {
($output,$stderr)=$destFH->cwd( # cd cmd handle to folder
$d_fdr); # that now has tar file
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
my $tdr='';
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr=$destFH->{_work_dirs}->{_tmp}
if $destFH->{_work_dirs}->{_tmp};
}
($output,$stderr)=
$destFH->cmd(
"chmod -v 755 ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # chmod it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=
$destFH->cmd(
"tar xovf ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # un-tar it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
#print "WHAT IS THE SHORTCUT HERE=$shortcut\n";sleep 6;
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
}
} else {
($output,$stderr)=$destFH->cwd( # cd cmd handle to dest folder
$dest_fdr);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
my $tdr='';
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr=$destFH->{_work_dirs}->{_tmp}
if $destFH->{_work_dirs}->{_tmp};
}
($output,$stderr)=$destFH->cmd("chmod -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 $Net::FullAuto::FA_Core::LOG $stderr."\nat Line: ".
"$l\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-7');
}
}
($output,$stderr)=$destFH->cmd("tar xovf ${d_fdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # un-tar it
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";
($output,$stderr)=$destFH->cmd("tar tvf ${d_fdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar");
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
($output,$stderr)=$destFH->cmd($cmd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
}
}
}
sub ftm_connect
{
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "ftm_connect() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "ftm_connect() CALLER=",
(join ' ',@topcaller)," and HOSTLABEL=$_[1]\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $ftpFH=$_[0];my $hostlabel=$_[1];my $_connect=$_[2]||'';
my $cache=$_[3]||'';my $ftm_type='';my $ftm_passwd='';
my $output='';my $stderr='';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fctimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,$_connect);
my @connect_method=@{$ftr_cnct};
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fctimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fctimeout) {
$fctimeout=$timeout if !$fctimeout;
}
my @hosts=();
if ($use eq 'ip') {
@hosts=($hostname,$ip);
} else {
@hosts=($ip,$hostname);
} my $host='';
if ($ping) {
while (1) {
my $error=0;
eval {
while ($host=pop @hosts) {
$ftpFH->{_cmd_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('ping')."ping $host");
while (my $line=
$ftpFH->{_cmd_handle}->get(
Timeout=>5)) {
if ($line=~/ from /s) {
#print "TEN003\n";
$ftpFH->{_cmd_handle}->print("\003");
while (my $ln=$ftpFH->{_cmd_handle}->get) {
last if $ln=~/_funkyPrompt_$/s;
} return;
} elsif (-1<index $line,'NOT FOUND'
|| -1<index $line,'Bad IP') {
if ($line=~/_funkyPrompt_$/s) {
$error=1;return;
}
}
}
}
};
if ($@) {
next if $error;
if (-1<index $@,'read timed-out') {
#print "ELEVEN003\n";
$ftpFH->{_cmd_handle}->print("\003");
while (my $ln=$ftpFH->{_cmd_handle}->get) {
last if $ln=~/_funkyPrompt_$/s;
} return 0;
} elsif ((-1<index $@,'read error') ||
(-1<index $@,'filehandle isn')) {
#print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
($ftpFH->{_cmd_handle}->{_cmd_handle},$stderr)=
&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$@);
if ($stderr) {
$stderr="$@\n $stderr";
return 0;
} elsif (!$ftpFH->{_cmd_handle}) {
return 0;
}
($output,$stderr)=$ftpFH->{_cmd_handle}->cmd(
"cd $ftpFH->{_work_dirs}->{_cwd}");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} elsif ($error) {
$error=0;next;
} last;
}
} elsif ($use eq 'ip') {
$host=$ip
} else { $host=$hostname }
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
'','__su__');
#print $Net::FullAuto::FA_Core::LOG "ftm_connect::cmd() BACK FROM PASSWD at Line: ",
# __LINE__,"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
#if ($ftm_passwd ne 'DoNotSU!') {
# $su_login=1;
#} else { $su_id='' }
$su_id=''
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,'');
}
$ftpFH->{_cmd_handle}->timeout($fctimeout);
my $fm_cnt=-1;
WE: while (1) {
foreach my $connect_method (@connect_method) {
$fm_cnt++;
if (lc($connect_method) eq 'ftp') {
$ftm_type='ftp';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});
if ($cfh_error) {
if ($cfh_error ne 'Invalid filehandle') {
#print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
($ftpFH->{_cmd_handle},$stderr)
=&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$stderr);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
@connect_method=();
@connect_method=@{$ftr_cnct};
next WE;
} else {
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-14');
}
}
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (6)
print "\n Logging into $host ($hostl) via ",
"ftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostl) via ".
"ftp . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (6) into $host ($hostl) via ",
"ftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging (6) into $host ($hostl) via ".
"ftp . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (6) into $host ($hostl) via ",
"ftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
$ftpFH->{_cmd_handle}->print(' '.
"${Net::FullAuto::FA_Core::ftppath}ftp $host");
FP: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftpFH->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete $Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}
=$value;
last FP;
}
}
}
}
my $lin='';$stderr='';
eval {
while (my $line=$ftpFH->{_cmd_handle}->get) {
my $tline=$line;
$tline=~s/Name.*$//s;
$lin.=$line;
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print $tline;
$cache->set($cache->{'key'},[0,$tline])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG $tline
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($lin=~/Name.*[: ]+$/si) {
$ftm_type='ftp';last;
}
$stderr.=$line;
if ($lin=~/s*ftp> ?$/s) {
$stderr=~s/^(.*?)(\012|\013)+//s;
$stderr=~s/s*ftp> ?$//s;
last;
}
}
};
if ($@) {
$ftpFH->{_cmd_handle}->print('bye');
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
return 0;
}
if ($su_id) {
$ftpFH->{_cmd_handle}->print($su_id);
} else {
$ftpFH->{_cmd_handle}->print($login_id);
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&wait_for_passwd_prompt($ftpFH);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$ftpFH->{_cmd_handle}->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);
next;
}
}
$ftm_type='ftp';last;
} elsif (lc($connect_method) eq 'sftp') {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});
if ($cfh_error && $cfh_error ne 'Invalid filehandle') {
#print "YEP GOT TO LOGIN_RETRY<==\n";
#print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
($ftpFH->{_cmd_handle},$stderr)
=&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$stderr);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
@connect_method=();
@connect_method=@{$ftr_cnct};
next WE;
}
$ftm_type='sftp';
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (7)
print "\n Logging into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (7) into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging (7) into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (7) into $host ($hostl) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
$sshport.=$id.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}.' ';
}
if ($su_id) {
print "\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$su_id\@$host at Line: ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$su_id\@$host at Line: ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$ftpFH->{_cmd_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$su_id\@$host");
} else {
print "\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$login_id\@$host at Line: ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$login_id\@$host at Line: ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$ftpFH->{_cmd_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$login_id\@$host");
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&wait_for_passwd_prompt($ftpFH);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$ftpFH->{_cmd_handle}->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);
next;
}
}
SP: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftpFH->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete $Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last SP;
}
}
}
}
$ftm_type='sftp';last;
}
} last;
}
my $die='';my $die_login_id='';my $ftm_errmsg='';
my $su_login='';my $retrys=0;
my %ftp=();my @choices=();
while (1) {
eval {
%ftp=(
_ftp_handle => $ftpFH->{_cmd_handle},
_ftp_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_hostlabel => [ $hostlabel, $ftpFH->{_hostlabel}->[0] ],
_uname => $uname,
_luname => $ftpFH->{_uname},
_ftp_pid => $ftpFH->{_ftp_pid}
);
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$ftm_passwd,$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
#print "I AM GOING TO TRY AND DO THE PROMPT\n";
eval {
$ftpFH->{_cmd_handle}->prompt("/s*ftp> ?\$/");
};
#print "GOT PAST THE PROMPT and EVALERR=$@\n";
################## MAKE NEW SUBROUTINE START HERE
my $lin='';my $asked=0;my $authyes=0;
while (1) {
$ftpFH->{_cmd_handle}->print;
while (my $line=$ftpFH->{_cmd_handle}->get) {
#print "LOOKING FOR FTPPROMPTLINE12=$line<==\n";
#print $Net::FullAuto::FA_Core::LOG "LOOKING FOR FTPPROMPTLINE12=$line<==\n"
#if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$line=~tr/\0-\11\13-\37\177-\377//d;
chomp($line);
$lin.=$line;
if ($lin=~/Perm/s && $lin=~/password[: ]+$/si) {
if ($su_id) {
if (!$asked++) {
my $error='';
($error=$lin)=~s/^\s*(.*)\n.*$/$1/s;
my $banner="\n The Host \"$hostlabel\" is "
."configured to attempt a su\n with "
."the ID \'$su_id\'\; however, the first "
."attempt\n resulted in the following "
."Error :\n\n $error\n\n It "
."may be that sftp is configured to "
."disallow logins\n with \'$su_id\'\."
."\n\n Please Pick an Operation :\n"
."\n NOTE: Choice will affect all "
."future logins!\n";
$choices[0]="Re-enter password and re-attempt with "
."\'$su_id\'";
$choices[1]="Attempt login with base id \'$login_id\'";
my $choice=&Menus::pick(\@choices,$banner);
chomp $choice;
if ($choice ne ']quit[') {
if ($choice=~/$su_id/s) {
my $show='';
($show=$lin)=~s/^.*?\n(.*)$/$1/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$show ";
my $newpass=<STDIN>;
chomp $newpass;
$ftpFH->{_cmd_handle}->print($newpass);
print $Net::FullAuto::FA_Core::LOG $show
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$lin='';last;
}
} else {
&Net::FullAuto::FA_Core::su_scrub(
$hostlabel,$su_id,$ftm_type);
&Net::FullAuto::FA_Core::passwd_db_update(
$hostlabel,$su_id,'DoNotSU!',
$ftm_type);
#print "TWELVE003\n";
$ftpFH->{_cmd_handle}->print("\003");
while (my $line=$ftpFH->{_cmd_handle}->get) {
print $Net::FullAuto::FA_Core::LOG "LLINE44=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$line=~s/\s*$//s;
last if $line=~/_funkyPrompt_$/s;
last if $line=~/Killed by signal 2\.$/s;
}
my $sshport='';
if (exists
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
$sshport.=$id.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'IdentityFile'}.' ';
}
print "\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),
'sftp ',
"${sshport}$login_id\@$host at Line: ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),
'sftp ',
"${sshport}$login_id\@$host at Line: ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$ftpFH->{_cmd_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').
'sftp '."${sshport}$login_id\@$host");
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&wait_for_passwd_prompt($ftpFH);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$ftpFH->{_cmd_handle}->("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);
next;
}
}
## Send password.
#print "444 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');
$ftpFH->{_cmd_handle}->print($ftm_passwd);
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||
$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (8)
print "\n ",
"Logging into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n ".
"Logging into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n ",
"Logging (8) into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging (8) ".
"into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (8) into $host ($hostl) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
last;
}
} else {
&Net::FullAuto::FA_Core::cleanup();
}
} elsif ($asked<4) {
#print "YESSSSSSS WE HAVE DONE IT FOUR TIMES22\n";<STDIN>;
}
} else {
## Send password.
#print "555 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";<STDIN>;
my $showerr='';
($showerr=$lin)=~s/^.*?\n(.*)$/$1/s;
$showerr=~s/^(.*)?\n.*$/$1/s;
$retrys++;
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$showerr,'','sftp','__force__');
$ftpFH->{_cmd_handle}->print($ftm_passwd);
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (9)
print "\n Logging into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n ",
"Logging (9) into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging (9) ".
"into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (9) into $host ($hostl) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
$lin='';next;
}
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
my $question=$lin;
$question=~s/^.*(The authen.*)$/$1/s;
$question=~s/\' can\'t/\'\ncan\'t/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$question ";
my $answer=<STDIN>;
chomp $answer;
if (lc($answer) eq 'yes') {
$ftpFH->{_cmd_handle}->print($answer);
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$authyes=1;$lin='';last;
} elsif (lc($answer) eq 'no') {
print $Net::FullAuto::FA_Core::LOG $lin
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::cleanup()
}
}
}
if ($line=~/[\$\%\>\#\-\:]+ ?$/m) {
$lin='';last;
} elsif ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
$lin='';last;
} elsif ($lin=~/Perm/s) { last }
}
if ($lin=~/Perm/s) {
$lin=~s/\s*//s;
$lin=~s/^(.*)?\n.*$/$1/s;
shift @connect_method;
die $lin;
} else { last }
}
################## MAKE NEW SUBROUTINE END HERE
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
};
if ($@=~/ogin incor/ && $retrys<2) {
$retrys++;
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);
$die_login_id=$su_id;
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$login_id);
$die_login_id=$login_id;
}
$ftpFH->{_cmd_handle}->print('bye');
while (my $line=$ftpFH->{_cmd_handle}->get) {
last if $line=~/_funkyPrompt_$/s;
}
$ftpFH->{_cmd_handle}->timeout($fctimeout);
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';
}
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'IdentityFile'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
$sshport.=$id.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'IdentityFile'}.' ';
}
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
if ($ftm_type eq 'ftp') {
print "\nFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ftp'),'ftp ',
"$host at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ftp'),'ftp ',
"$host at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$ftpFH->{_cmd_handle}->print(
" ${Net::FullAuto::FA_Core::ftppath}ftp $host");
} elsif ($ftm_type eq 'sftp') {
if ($su_id) {
print "\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$su_id\@$host at Line: ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$su_id\@$host at Line: ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$ftpFH->{_cmd_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$su_id\@$host");
} else {
print "\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$login_id\@$host at Line: ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$login_id\@$host at Line: ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$ftpFH->{_cmd_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').
"sftp ${sshport}$login_id\@$host");
}
}
$ftpFH->{_cmd_handle}->
waitfor(-match => '/Name.*[: ]+$/i');
$@='';next;
} elsif ($@) {
my $f_t=$ftm_type;$f_t=~s/^(.)/uc($1)/e;
$die="The System $host Returned\n the "
."Following Unrecoverable Error Condition\,\n"
." XRejecting the $f_t Login Attempt"
." of the ID\n -> $die_login_id "
."at ".(caller(0))[1]." "
."line ".(caller(2))[2]." :\n\n $@";
} else { last }
}
if (defined $transfer_dir && $transfer_dir) {
if (unpack('@1 a1',$transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 @2 a*',$transfer_dir);
$path=~tr/\\/\//;
$transfer_dir="/cygdrive/$drive$path/";
}
my ($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$transfer_dir\"",$cache);
foreach my $line (split /^/, $output) {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print $line;
$cache->set($cache->{'key'},[0,$line])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG $line
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
next if $line!~/^\d/;
if (unpack('a3',$line)!=250) {
my $warn="The FTP Service Cannot Change to "
."the Transfer Directory"
."\n\n -> $line\n";
warn "$warn $!";return 0;
}
} $Net::FullAuto::FA_Core::ftpcwd{$ftpFH->{_cmd_handle}}{cd}=$transfer_dir;
} return 1;
}
sub dup_Processes
{
my $cmd_handle=$_[0];
foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($cmd_handle
eq $Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}) {
return 1;
}
}
}
} return 0;
}
sub map_mirror
{
my $mirrormap=$_[0];
my $map='mirrormap';
my @keys=split '/',"$_[1]";
my $file="$_[3]";
my $reason="$_[4]";
my $num_of_levels=$#keys;
#print "REASON=$reason\n";
#print "KEYS=@keys\n";
#print "NUM_OF_LEVELS=$num_of_levels\n";
if ($_[1] eq '/') {
eval "\@{\${\$$map}[0]}[0,1,2]=(\'all\',\'/\',\'\')";
} elsif ($file ne '') {
if ("$_[2]" eq 'EXCLUDE') {
eval "push \@{\${\${\$$map}[0]}[4]}, [ \"\$file\",\"\$reason\" ]";
} else {
eval "push \@{\${\${\$$map}[0]}[3]}, [ \"\$file\",\"\$reason\" ]";
}
} else {
my $num_decrement=$num_of_levels;
my ($exclude,$num,$num_of_elem)='';
while (-1<$num_decrement--) {
$num_of_elem=eval "\$\#{$map}";
$num_of_elem=0 if $num_of_elem==-1;
$map.="\}\[$num_of_elem\]";
$map="\$\{$map";
$num++;
#print "NUM=$num and KEYS=$#keys\n";
if ("$_[2]" eq 'EXCLUDE') {
#print "MAPP1=$map and $keys[$num]\n";
eval "\@{\${\$$map}[0]}[0]=\'some\'";
#print "MIRRORMAP=$mirrormap and THIS=${${${$mirrormap}[0]}[0]}[0]\n";<STDIN>;
# print "GOT THE GOODS=",eval "\@{\${\$$map}[0]}[2]","\n";
if (eval "\${\${\$$map}[0]}[2]" eq 'EXCLUDE') {
$exclude='EXCLUDE';
}
} elsif ($#keys==$num) {
eval "\@{\${\$$map}[0]}[0,1,2]=(\'all\',\'$keys[$num]\',\'\')";
#print "MIRRORMAP=$mirrormap and THIS=${${${$mirrormap}[0]}[0]}[0]\n";<STDIN>;
}
}
}
return $mirrormap;
}
sub move_files
{
#print "MOVE_FILESCALLER=",caller,"\n";<STDIN>;
my ($baseFH,$key,$file,$dest_fdr,
$destFH,$bms_share,$dms_share,$nosubs,
$local_transfer_dir,$trantar,$bhostlabel,
$dhostlabel,$parentkey,$shortcut) = @_;
#print "BASEFH=$baseFH\n";
#print "KEY=$key\n";
#print "FILE=$file\n";
#print "DEST_FDR=$dest_fdr\n";
#print "DESTFH=$destFH\n";
#print "BMS_SHARE=$bms_share\n";
#print "DMS_SHARE=$dms_share\n";
#print "NOSUBS=$nosubs\n";
#print "LOCALTRANSFERDIR=$local_transfer_dir\n";
#print "TRANTAR=$trantar\n";
#print "BHOSTLABEL=$bhostlabel\n";
#print "DHOSTLABEL=$dhostlabel\n";<STDIN>;
my $basefile='';my $basedir='';my $destdir='';my $msprxFH='';
my $w32copy='';my $output='';my $stderr='';my $destd='';my $baseprx='';
if ($bms_share || $baseFH->{_uname} eq 'cygwin') {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd};
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd}$key";
} $basedir.='/' if $file;
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
if ($dhostlabel ne "__Master_${$}__") {
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$key";
} $destdir.='/' if $file;
} elsif (unpack('a1',$dest_fdr) eq '/') {
my $testd=&test_dir($destFH,$dest_fdr);
if ($destFH->{_uname} eq 'cygwin') {
my $testd=&test_dir($destFH,$dest_fdr);
if ($testd ne 'WRITE') {
if ($testd eq 'NODIR') {
my $destdir_mswin='';
($destdir,$destdir_mswin)
=&File_Transfer::get_drive($dest_fdr,'Destination',
'',$dhostlabel);
($output,$stderr)=$destFH->cwd($destdir);
my $die="Destination Directory $dest_fdr\n"
.' Does NOT Exist!:\n\n '
.$stderr;
if ($stderr) {
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
}
} else {
my $die="Destination Directory $dest_fdr\n"
.' is NOT Writable!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
}
}
$dest_fdr=&Net::FullAuto::FA_Core::attempt_cmd_xtimes($destFH,
'cmd /c chdir',$dhostlabel);
$dest_fdr=unpack('a2',$dest_fdr);
$dest_fdr=~tr/\\/\//;
} elsif ($testd ne 'WRITE') {
if ($testd eq 'NODIR') {
my $die="Destination Directory $dest_fdr\n"
.' Does NOT Exist!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
} else {
my $die="Destination Directory $dest_fdr\n"
.' is NOT Writable!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
}
}
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$destdir/$key";
} $destdir.='/' if $file;
} elsif (unpack('x1 a1',$dest_fdr) eq ':') {
$destFH->{_work_dirs}->{_pre}=
$destFH->{_work_dirs}->{_cwd};
$destFH->{_work_dirs}->{_pre_mswin}=
$destFH->{_work_dirs}->{_cwd_mswin};
my ($drive,$path)=unpack('a1 x1 a*',$dest_fdr);
$path=~tr/\\/\//;
$destFH->{_work_dirs}->{_cwd_mswin}=$dest_fdr;
$destFH->{_work_dirs}->{_cwd}=$destFH->{_cygdrive}
.'/'.lc($drive).$path.'/';
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$key";
} $destdir.='/' if $file;
} else {
if ($key eq '/') {
$destdir=$destFH->cmd('pwd');
} else {
$destdir=$destFH->cmd('pwd')."/$key";
} $destdir.='/' if $file;
$destdir=~tr/\\/\//;
}
} else {
if ($destFH->{_work_dirs}->{_tmp}) {
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd_mswin}$key";
} $destdir.='/' if $file;
} elsif ($key ne '/') {
$destdir=$key;
}
$trantar=1;
}
} elsif ($dms_share) {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd_mswin};
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd_mswin}$key";
$destdir="$destFH->{_work_dirs}->{_cwd_mswin}$key";
} $basedir.='/' if $file;
$destdir.='/' if $file;
$destdir=~tr/\//\\/;
$destdir=~s/\\/\\\\/g;
} else {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd_mswin};
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd_mswin}$key";
} $basedir.='/' if $file;
$destdir=$key;$trantar=1;
}
my $b_OS='';my $m_OS='';my $d_OS='';my $FH='';
if ($^O eq 'cygwin') {
if ($bms_share || ($baseFH->{_uname} eq 'cygwin' &&
$bhostlabel eq "__Master_${$}__")) {
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
$b_OS=$m_OS=$d_OS='cygwin';
} else {
$b_OS=$m_OS='cygwin';
$d_OS='Unix';
} $msprxFH=$Net::FullAuto::FA_Core::localhost;
} elsif ($dms_share) {
$m_OS=$d_OS='cygwin';
$b_OS='Unix';
#print "HEREEEEEEEEE7\n";
$msprxFH=$Net::FullAuto::FA_Core::localhost;
$Net::FullAuto::FA_Core::tran[1]="__Master_${$}__";
if ($msprxFH->{_work_dirs}->{_tmp}) {
my ($output,$stderr)=$msprxFH->cwd(
$msprxFH->{_work_dirs}->{_tmp});
if ($stderr) {
@FA_Core::tran=();
my $die="Cannot cd to TransferDir -> "
."$msprxFH->{_work_dirs}->{_tmp}\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die,'-6');
} $Net::FullAuto::FA_Core::tran[0]=$msprxFH->{_work_dirs}->{_tmp};
} else {
$Net::FullAuto::FA_Core::tran[0]=$msprxFH->cmd('pwd');
}
} else {
$m_OS='cygwin';
$b_OS=$d_OS='Unix';
}
} else {
if ($bms_share || $baseFH->{_uname} eq 'cygwin') {
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
$b_OS=$d_OS='cygwin';
$m_OS='UNIX';
#print "HEREEEEEEEEE8\n";
$msprxFH=$baseFH;
} else {
$b_OS='cygwin';
$m_OS=$d_OS='Unix';
}
} elsif ($dms_share) {
$d_OS='cygwin';
$b_OS=$m_OS='Unix';
#print "HEREEEEEEEEE9\n";
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};
} else {
$b_OS=$m_OS=$d_OS='Unix';
}
}
&move_file_list($file,$basedir,
$destdir,$msprxFH,$baseFH,
$destFH,$key,$w32copy,
$local_transfer_dir,
$b_OS,$m_OS,$d_OS,
$parentkey)
if !$shortcut || !$msprxFH || $b_OS ne 'cygwin';
return $trantar;
}
sub move_file_list
{
my @topcaller=caller;
#print "MOVEFILELISTCALLER=",(join ' ',@topcaller),"\n"
# if !$Net::FullAuto::FA_Core::cron &&
# $Net::FullAuto::FA_Core::debug;
my ($file,$basedir,$destdir,$msprxFH,$baseFH,
$destFH,$key,$w32copy,$local_transfer_dir,
$b_OS,$m_OS,$d_OS,$parentkey,$shortcut)=@_;
#print "BASEDIR=$basedir<===\n";#<STDIN>;
my $farg='';my $filearg='';my $proxydir='';
my $output='';my $stderr='';
if ($msprxFH) { ### if MS Proxy Needed
if ($b_OS eq 'cygwin') { ### if Base Needs Proxy
if ($d_OS eq 'cygwin') { ### Dest Does Not Need Proxy
foreach my $fil (@{$file}) {
$fil=~s/%/\\%/g;
$farg.="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
if (1500<length "$farg$destdir") {
$filearg=~tr/\\/\//;
$destdir.=$key if $key;
$destdir=~tr/\\/\//;
chop $filearg;
my $td="--target-directory=$destdir";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap_');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
'',$msprxFH,'')
}
}
$farg="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
} $filearg=$farg;
}
if ($filearg) {
$filearg=~tr/\\/\//;
$destdir=~tr/\\/\//;
chop $filearg;
my $td="--target-directory=$destdir";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$destdir,$msprxFH,'')
}
}
} #else {
# &move_MSWin_stderr('','',$destdir,$msprxFH,'')
#}
} else { ### Dest Needs Proxy
if ($key && $key ne '/' && ($file
|| $parentkey eq ')DIRONLY')) {
$proxydir="\".\\transfer$Net::FullAuto::FA_Core::tran[3]\\$key\"";
} else {
$proxydir="\".\\transfer$Net::FullAuto::FA_Core::tran[3]$parentkey\"";
}
$proxydir=~tr/\\/\//;
my $td="--target-directory=$proxydir";
if ($file) {
foreach my $fil (@{$file}) {
$fil=~s/%/\\%/g;
$farg.="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
if (1500<length "$farg$proxydir") {
$filearg=~tr/\\/\//;
chop $filearg;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$proxydir,$msprxFH,'')
}
}
$farg="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
} $filearg=$farg;
}
if ($filearg) {
$filearg=~tr/\\/\//;
chop $filearg;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$proxydir,$msprxFH,'')
}
}
} #else {
# &move_MSWin_stderr('','',$proxydir,$msprxFH,'')
#}
} elsif ($parentkey ne ')DIRONLY') {
my $fdot='';
$fdot='/.' if $key eq '/';
#$filearg.="\'$baseFH->{_work_dirs}->[0]$basedir$fdot\'";
$filearg.="\'$baseFH->{_work_dirs}->{_cwd}$fdot\'";
$filearg=~tr/\\/\//;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -Rfpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$proxydir,$msprxFH,'R')
}
}
} else {
&move_MSWin_stderr('','',$proxydir,$msprxFH,'')
}
}
} else { ### Dest Needs Proxy
$destdir=~tr/\\/\//;
my $td.=$destdir;
$td="--target-directory=$td";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -Rfpv ./transfer".
"$Net::FullAuto::FA_Core::tran[3]/* \"$td\"");
if ($stderr) {
my $die="Could not Execute the Command :"
."\n\n cmd /c cp -Rfpv ./transfer"
."$Net::FullAuto::FA_Core::tran[3]/* \"$td\"\n\n "
. $stderr;
&Net::FullAuto::FA_Core::handle_error($die,'-7');
}
}
}
}
sub clean_process_files
{
my @topcaller=caller;
print "CLEAN_PROCESS_FILES-CALLER=",
(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
my $self=$_[0];
my $pid_ts=pop @FA_Core::pid_ts;
$pid_ts||='';return '','' if !$pid_ts;
my $str="echo \"del rm${pid_ts}.bat\"";
my $output='';my $stderr='';
$str.=" >> rm${pid_ts}.bat";
($output,$stderr)=$self->cmd($str);
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;
my $die= "$stderr\n\n From Command -> " . "\"$str\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
if ($self->{_uname} eq 'cygwin') {
$output=join '',$self->{_cmd_handle}->cmd(
"cmd /c rm${pid_ts}.bat");
} else {
$output=join '',$self->{_cmd_handle}->{_cmd_handle}->cmd(
"cmd /c rm${pid_ts}.bat");
}
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;
my $die="$stderr\n\n From Command -> "
."\"cmd /c rm${pid_ts}.bat\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
}
sub move_MSWin_stderr
{
#print "MSWin_stderrCALLER=",caller,"\n";
my ($stderr,$filearg,$destdir,$FH,$option)=@_;
my $output='';
if (!$stderr || (-1<index $stderr,"No such file")
|| (-1<index $stderr,"not a directory")) {
my $destd='';
if (unpack('a10',$destdir) eq '/cygdrive/') {
$destd=unpack('x10 a*',$destdir);
$destd=~s/^(.)/$1:/;
} else { $destd=$destdir }
$destd=~tr/\//\\/;
$stderr='';
($output,$stderr)=$FH->cmd(
"cmd /c mkdir \"$destd\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr
&& (-1==index $stderr,'already exists');
if (!$Net::FullAuto::FA_Core::tran[4] &&
17<length $destd &&
-1<index $destd,"transfer$Net::FullAuto::FA_Core::tran[3]") {
$Net::FullAuto::FA_Core::tran[0]=
"transfer$Net::FullAuto::FA_Core::tran[3]";
$Net::FullAuto::FA_Core::tran[1]= ($FH->{_hostlabel}->[1]) ?
$FH->{_hostlabel}->[1] : $FH->{_hostlabel}->[0];
$Net::FullAuto::FA_Core::tran[4]=1;
} return if !$filearg;
$stderr='';
my $td="--target-directory=$destdir";
my $e_cnt=0;
($output,$stderr)=$FH->cmd(
"cmd /c cp -${option}fpv $filearg $td");
if ($stderr) {
my $subwarn="WARNING! COPY ERROR";
my %mail=(
'Body' => "$stderr",
'Subject' => "$subwarn AND \$filearg=$filearg"
);
&Net::FullAuto::FA_Core::send_email(\%mail);
print $Net::FullAuto::FA_Core::LOG $stderr
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::handle_error($stderr,'-12') if $stderr
&& (-1==index $stderr,'already exists');
}
} else {
print $Net::FullAuto::FA_Core::LOG $stderr
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1');
}
}
sub build_mirror_hashes
{
my $hostlabel='';
my $timehash={};my $num_of_files=0;my $num_of_basefiles=0;
my $timekey='';my $deploy_needed=0;my $output='';
my $baseFH=$_[0];
my $destFH=$_[1];
my $bhostlabel=$_[2];
my $dhostlabel=$_[3];
my $verbose=$_[4];
my $cache=$_[5];
my $base_uname='';
my $dest_uname='';
my $base_windows_daylight_savings=0;
my $dest_windows_daylight_savings=0;
my $stdout='';
my $stderr='';
my $deploy_empty_dir=0;
my $dest_dir_status='';
my $deploy_info='';
my $debug_info='';
eval {
$num_of_files=${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"}
if exists ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"};
delete ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"};
$num_of_basefiles=
${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"}
if exists ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"};
delete ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"};
delete ${$destFH->{_dhash}}{"___%EXCluD%E--NUMOFFILES"};
delete ${$destFH->{_dhash}}{"___%EXCluD%E--NUMOFBASEFILES"};
if ($num_of_files) {
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";
$cache->set($cache->{'key'},[0,
"mirror() NUM_OF_FILES=$num_of_files\n".
"mirror() NUM_OF_BASEFILES=$num_of_basefiles\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
}
foreach my $key (sort keys %{$baseFH->{_bhash}}) {
next if ${$baseFH->{_bhash}}{$key}[0] eq 'EXCLUDE';
my @keys=();
if (${$baseFH->{_bhash}}{$key}[2] eq 'DEPLOY_NOFILES_OF_CURDIR') {
${$baseFH->{_bhash}}{$key}[0]='SOME';
if (-1<index $key,'/') {
my $chkkey=$key;
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;
last if -1==index $chkkey,'/';
}
} unshift @keys, '/';
foreach my $key (@keys) {
${$baseFH->{_bhash}}{$key}[0]='SOME';
} next
}
my $dest_dir_status='';
if ($key ne '/') {
if (-1==$#keys) {
if (-1<index $key,'/') {
my $chkkey=$key;
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;
last if -1==index $chkkey,'/';
}
} unshift @keys, '/';
}
if (!exists ${$destFH->{_dhash}}{$key}) {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "mirror() ERROR: WHAT IS THE BAD KEY==>$key<==\n";
$cache->set($cache->{'key'},[0,
"mirror() ERROR: WHAT IS THE BAD KEY==>$key<==\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"mirror() ERROR: WHAT IS THE BAD KEY==>$key<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#print "HERE1=$key\n";
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE3\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
${$baseFH->{_bhash}}{$key}[3]='NOT_ON_DEST';
$dest_dir_status='DIR_NOT_ON_DEST';
$deploy_info.=" DEPLOY EMPTY DIR $key - DIR_NOT_ON_DEST\n";
$debug_info.="DEPLOY EMPTY DIR $key - DIR_NOT_ON_DEST\n";
$deploy_empty_dir=$deploy_needed=1;
} else {
#print "HERE2=$key\n";
${$baseFH->{_bhash}}{$key}[3]='DIR_ON_DEST';
$dest_dir_status='DIR_ON_DEST';
}
}
my $skip=0;my $deploy=0;
foreach my $file (sort keys %{${$baseFH->{_bhash}}{$key}[1]}) {
#if ($key=~/yglasa/) {
#print "DEST_DIR_STATUS=$dest_dir_status and KEY=$key\n";
#print "FILE=$file and BASEHASH=",
# @{${$baseFH->{_bhash}}{$key}[1]{$file}},"<==\n";
#print "DESTHASH=",${$destFH->{_dhash}}{$key}[1]{$file},"\n" if exists
# ${$destFH->{_dhash}}{$key}[1]{$file};<STDIN>;
#}
if (${$baseFH->{_bhash}}{$key}[1]{$file}[0] eq 'EXCLUDE') {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "mirror() SKIP1=> KEY=$key and FILE=$file\n";
$cache->set($cache->{'key'},[0,
"mirror() SKIP1=> KEY=$key and FILE=$file\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"mirror() SKIP1=> KEY=$key and FILE=$file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($key eq '/') {
$debug_info.="SKIP FILE $file - EXCLUDED_BY_FILTER\n";
} else {
$debug_info.="SKIP FILE $key/$file - EXCLUDED_BY_FILTER\n";
}
$skip=1;next;
} my $dchmod='';my $dtime='';my $dyear='';my $dsize='';
my $dtime1='';my $dtime2='';my $dtime3='';
my $y=qr(\d\d\d\d|0);my $k=qr(\s+\d+\s+\d+|\s+--\s+--);
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";
$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 $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
${${$destFH->{_dhash}}{$key}[1]{$file}}[1]=~
/^(\d+\s+)(\d+)($k)\s+($y)\s+(\d+)\s*(\d*)*\s*$/;
$dtime1=$1||0;$dtime2=$2||0;$dtime3=$3||0;
$dyear=$4||0;$dsize=$5||0;$dchmod=$6||0;
$dtime2="0$dtime2" if length $dtime2==1;
$dtime=$dtime1.$dtime2.$dtime3;
$dchmod||='';
}
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1]=~
/^(\d+\s+)(\d+)($k)\s+($y)\s+(\d+)\s*(\d*)*\s*$/;
my $btime1=$1||0;my $btime2=$2||0;
my $btime3=$3||0;
my $byear=$4||0;my $bsize=$5||0;my $bchmod=$6||0;
$btime2="0$btime2" if length $btime2==1;
my $btime=$btime1.$btime2.$btime3;
$bchmod||='';
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";
$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 $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
if ($dest_dir_status eq 'DIR_NOT_ON_DEST') {
if ($key eq '/') {
$deploy_info.=" DEPLOY FILE $file - DIR_NOT_ON_DEST\n";
$debug_info.="DEPLOY FILE $file - DIR_NOT_ON_DEST\n";
if (99<length "$key/$file") {
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE7\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=$file;
}
} else {
$deploy_info.=
" DEPLOY FILE $key/$file - DIR_NOT_ON_DEST\n";
$debug_info.="DEPLOY FILE $key/$file - DIR_NOT_ON_DEST\n";
if (99<length "$key/$file") {
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE8\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE4\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#print "HERE3=$key\n";
#print "DESTKEYS=",keys %{$destFH->{_dhash}},"\n";<STDIN>;
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="NOT_ON_DEST $bsize $dsize";
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
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";
$cache->set($cache->{'key'},[0,
"mirror() DEPLOY NEEDED for KEY=$key and ".
"FILE=$file because DIR_NOT_ON_DEST\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG "DO WEX REALLY GET HERE5\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
$deploy_needed=$deploy=1;
$btime=~tr/ //;
if ($key ne '/') {
$timekey="$key/$file";
} 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";
$cache->set($cache->{'key'},[0,
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ".
"and BYEAR=$byear and BTIME=$btime\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$timehash->{$timekey}=[$byear,$btime];
next;
}
if (exists ${$destFH->{_dhash}}{$key}[1]{$file}) {
if ($bsize ne $dsize) {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="DIFF_SIZE $bsize $dsize";
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(a) $file - DIFF_SIZE\n";
$debug_info.="DEPLOY(a) $file - DIFF_SIZE\n";
} else {
$deploy_info.=" DEPLOY $file - DIFF_SIZE\n";
$debug_info.="DEPLOY $file - DIFF_SIZE\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(b) $key/$file - DIFF_SIZE\n";
$debug_info.="DEPLOY(b) $key/$file - DIFF_SIZE\n";
} else {
$deploy_info.=" DEPLOY $key/$file - DIFF_SIZE\n";
$debug_info.="DEPLOY $key/$file - DIFF_SIZE\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
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";
$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 $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
$deploy_needed=$deploy=1;
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
$btime=~tr/ //;
if ($key ne '/') {
$timekey="$key/$file";
} else { $timekey=$file }
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";
$cache->set($cache->{'key'},[0,
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ".
"and BYEAR=$byear and BTIME=$btime\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
${$timehash}{$timekey}=[$byear,$btime];
next;
}
my ($bmndy,$bhr,$bmt)
=unpack('a5 x1 a2 x1 a2',$btime);
my ($dmndy,$dhr,$dmt)
=unpack('a5 x1 a2 x1 a2',$dtime);
if ($btime ne $dtime) {
my $btim=unpack('x6 a2',$btime);
my $dtim=unpack('x6 a2',$dtime);
my $testdhr=$dtime;
my $testbhr=$btime;
if ($btim eq '--' || $dtim eq '--') {
substr($testdhr,6,2)='12';
substr($testbhr,6,2)='12';
substr($testdhr,9,2)='00';
substr($testbhr,9,2)='00';
substr($btime,6,2)='12';
substr($dtime,6,2)='12';
substr($btime,9,2)='00';
substr($dtime,9,2)='00';
$dtim=0;$btim=0;
} else {
my $btme=$btime;
my $dtme=$dtime;
substr($btme,6,2)='';
substr($dtme,6,2)='';
my $testnum='';
if ($dtim<$btim) {
$testnum=$btim-$dtim;
} else { $testnum=$dtim-$btim }
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
if ($dhr eq '23') {
substr($testdhr,6,2)='01';
} else {
my $ddhr=$dhr+1;
$ddhr='0'.$ddhr if length $ddhr==1;
substr($testdhr,6,2)=$ddhr;
}
if ($bhr eq '23') {
substr($testbhr,6,2)='01';
} else {
my $bbhr=$bhr+1;
$bbhr='0'.$bbhr if length $bbhr==1;
substr($testbhr,6,2)=$bbhr;
}
}
my $dff=$btim-$dtim;
$dff*=-1 if $dff<0;
$dest_uname=$destFH->{_uname} unless $dest_uname;
if ($dest_uname eq 'cygwin' && $dff==1) {
my $key_dir=($key ne '/')?"$key/":'';
($stdout,$stderr)=$destFH->cmd(
"stat \"$key_dir$file\"");
my $isto=(index $stdout,'Modify: ')+19;
$stdout=unpack("x$isto a2",$stdout);
my $st=unpack('x6 a2',
${${$destFH->{_dhash}}{$key}[1]{$file}}[1]);
$dest_windows_daylight_savings=($st ne $stdout)?1:0;
}
$base_uname=$baseFH->{_uname} unless $base_uname;
if ($base_uname eq 'cygwin' && $dff==1) {
my $key_dir=($key ne '/')?"$key/":'';
($stdout,$stderr)=$baseFH->cmd("stat \"$key_dir$file\"");
my $isto=(index $stdout,'Modify: ')+19;
$stdout=unpack("x$isto a2",$stdout);
my $st=unpack('x6 a2',
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1]);
$base_windows_daylight_savings=($st ne $stdout)?1:0;
}
my $bddd=$base_windows_daylight_savings-
$dest_windows_daylight_savings;
$bddd*=-1 if $bddd<0;
if ((!$btim && !$dtim) || ($dff==1 && $bddd==1)) {
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
$skip=1;
if ($key eq '/') {
$debug_info.=
"SKIP FILE $file - SAME_SIZE_TIME_STAMP1\n";
} else {
$debug_info.=
"SKIP FILE $key/$file - SAME_SIZE_TIME_STAMP1\n";
}
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="SAME $btime $bsize";
next;
} elsif ($dtim<$btim &&
exists $Net::FullAuto::FA_Core::Hosts{
$dhostlabel}{'TimeStamp'}
&& lc($Net::FullAuto::FA_Core::Hosts{$dhostlabel}
{'TimeStamp'}) eq 'newer') {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="NEWR_TIME $btime $dtime";
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(c) $file - NEWR_TIME\n";
$debug_info.="DEPLOY(c) $file - NEWR_TIME\n";
} else {
$deploy_info.=" DEPLOY $file - NEWR_TIME\n";
$debug_info.="DEPLOY $file - NEWR_TIME\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=
" DEPLOY(d) $key/$file - NEWR_TIME\n";
$debug_info.="DEPLOY(d) $key/$file - NEWR_TIME\n";
} else {
$deploy_info.=
" DEPLOY $key/$file - NEWR_TIME\n";
$debug_info.="DEPLOY $key/$file - NEWR_TIME\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
$deploy_needed=$deploy=1;
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
} else {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="DIFF_TIME $btime $dtime";
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(e) $file - DIFF_TIME\n";
$debug_info.="DEPLOY(e) $file - DIFF_TIME\n";
} else {
$deploy_info.=" DEPLOY $file - DIFF_TIME\n";
$debug_info.="DEPLOY $file - DIFF_TIME\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=
" DEPLOY(f) $key/$file - DIFF_TIME\n";
$debug_info.="DEPLOY(f) $key/$file - DIFF_TIME\n";
} else {
$deploy_info.=
" DEPLOY $key/$file - DIFF_TIME\n";
$debug_info.="DEPLOY $key/$file - DIFF_TIME\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
$deploy_needed=$deploy=1;
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
}
} else {
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="SAME $btime $bsize";
if ($key eq '/') {
$debug_info.=
"SKIP FILE $file - SAME_SIZE_TIME_STAMP2\n";
} else {
$debug_info.=
"SKIP FILE $key/$file - SAME_SIZE_TIME_STAMP2\n";
}
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
$skip=1;next;
}
} else {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]='NOT_ON_DEST';
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
if ($key eq '/') {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(g) $file - NOT_ON_DEST\n";
$debug_info.="DEPLOY(g) $file - NOT_ON_DEST\n";
} else {
$deploy_info.=" DEPLOY $file - NOT_ON_DEST\n";
$debug_info.="DEPLOY $file - NOT_ON_DEST\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=$file;
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$deploy_info.=" DEPLOY(h) $key/$file - NOT_ON_DEST\n";
$debug_info.="DEPLOY(h) $key/$file - NOT_ON_DEST\n";
} else {
$deploy_info.=" DEPLOY $key/$file - NOT_ON_DEST\n";
$debug_info.="DEPLOY $key/$file - NOT_ON_DEST\n";
}
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
$deploy_needed=$deploy=1;
}
$btime=~tr/ //;
if ($key ne '/') {
$timekey="$key/$file";
} else { $timekey=$file }
${$timehash}{$timekey}=[$byear,$btime];
print $Net::FullAuto::FA_Core::LOG
"UPDATEING TIMEHASH3=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
if ($skip) {
if ($deploy) {
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_SOMEFILES_OF_CURDIR';
${$baseFH->{_bhash}}{$key}[0]='SOME';
foreach my $key (@keys) {
${$baseFH->{_bhash}}{$key}[0]='SOME';
}
} else {
delete ${$destFH->{_dhash}}{$key}
if !keys %{${$destFH->{_dhash}}{$key}[1]};
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_NOFILES_OF_CURDIR';
${$baseFH->{_bhash}}{$key}[0]='EXCLUDE'
if ${$baseFH->{_bhash}}{$key}[0] ne 'SOME'
&& ${$baseFH->{_bhash}}{$key}[0] ne 'NOT_ON_DEST';
}
} elsif ($deploy) {
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_SOMEFILES_OF_CURDIR';
} else {
delete ${$destFH->{_dhash}}{$key}
if !keys %{${$destFH->{_dhash}}{$key}[1]};
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_NOFILES_OF_CURDIR';
${$baseFH->{_bhash}}{$key}[0]='EXCLUDE'
if ${$baseFH->{_bhash}}{$key}[0] ne 'SOME'
&& ${$baseFH->{_bhash}}{$key}[0] ne 'NOT_ON_DEST'
&& !$deploy_empty_dir;
} $deploy_empty_dir=0;
} ${$baseFH->{_bhash}}{'/'}[0]='EXCLUDE' if !$deploy_needed;
};
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','','',$@;
} else {
my $die="The System $hostlabel Returned"
."\n the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n $@";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return '','','','',$die;
}
}
print $Net::FullAuto::FA_Core::LOG "KEYSBASEHASHTEST=",keys %{$baseFH->{_bhash}},"\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
return $baseFH, $destFH, $timehash, $deploy_info, $debug_info;
}
sub build_base_dest_hashes
{
#print "BBDH CALLER=",caller,"\n";
my $modifiers='';my $mod_dirs_flag='';
my $mod_files_flag='';my $s=0;
my $num_of_included=0;my $num_of_excluded=0;
my @modifiers=();
my $base_or_dest_folder=$_[0];
my $ms_share=$_[4];$ms_share||='';
my $ms_domain=$_[5];$ms_domain||='';
my $cygwin = (-1<index lc($_[6]),'cygwin') ? 1 : 0;
my $cmd_handle=$_[7];$cmd_handle||='';
my $base_dest=$_[8];
my $lsgnu=$_[9];
my $zipdir=$_[10]||'';
my $cache=$_[11]||'';
my $bd='';
$bd=($base_dest eq 'BASE')?'b':'d';
my ($stdout,$stderr)=('','');
my %navhash=();
eval {
if ($_[2]) { # If we have Directives
my @directives=@{$_[2]};my @delim=();
foreach my $directive (@directives) {
$s=0;$s=1 if $directive=~/^s/;
if ($s==1 || substr($directive,0,1) eq 'm') {
$delim[0]=substr($directive,1,1);
} else { $delim[0]=substr($directive,0,1); }
if ($delim[0] eq '(') { $delim[1]=')' }
elsif ($delim[0] eq '[') { $delim[1]=']' }
elsif ($delim[0] eq '{') { $delim[1]='}' }
else { $delim[1]=$delim[0] }
my $rindex=rindex $directive,$delim[1];
my $modifiers=lc(substr($directive,$rindex+1));
my $regex=substr($directive,(index $directive,$delim[0])+1,
$rindex-1);
my $perl_mods='';
my $mods='';
if ($directive=~/^s/) {
$s=1;
$perl_mods.='g' if -1<index $modifiers,'g';
$perl_mods.='e' if -1<index $modifiers,'e';
} elsif (-1<index $modifiers,'e') { $mods.='e' }
$perl_mods.='i' if -1<index $modifiers,'i';
if (-1<index $modifiers,'d') {
if ($s) {
push @modifiers, [ qr/$regex/,$perl_mods,"s$mods",'d' ];
} elsif (-1<index $modifiers,'e') {
push @modifiers, [ qr/$regex/,$perl_mods,$mods,'d' ];
} else {
push @modifiers, [ qr/$regex/,$perl_mods,"${mods}i",'d' ];
} $mod_dirs_flag=1;
} else {
if ($s) {
push @modifiers, [ qr/$regex/,$perl_mods,"s$mods",'f' ];
} elsif (-1<index $modifiers,'e') {
push @modifiers, [ qr/$regex/,$perl_mods,$mods,'f' ];
} else {
push @modifiers, [ qr/$regex/,$perl_mods,"${mods}i",'f' ];
} $mod_files_flag=1;
}
}
sub regx_prog
{
my @topcaller=caller;
print "regx_prog() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "regx_prog() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $ex=$_[0];my $type=$_[1];
my $sub = sub {
my $result=0;my $string='';$_[1]||='';
if ($type eq 'f' && $_[1] ne ''
&& -1<index ${$ex}[0],'/') {
if ($_[1] eq '/') {
$string=$_[0];
} else {
$_[1]=~s/\/+$//;
$string="$_[1]/$_[0]";
}
} else { $string=$_[0] }
if (-1<index ${$ex}[1],'s') {
if (-1<index ${$ex}[1],'g') {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#sgi;
} else {
$result=1 if $string=~m#${$ex}[0]#sg;
}
} else {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#si;
} else {
$result=1 if $string=~m#${$ex}[0]#s;
}
}
} elsif (-1<index ${$ex}[1],'m') {
if (-1<index ${$ex}[1],'g') {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#mgi;
} else {
$result=1 if $string=~m#${$ex}[0]#mg;
}
} else {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#mi;
} else {
$result=1 if $string=~m#${$ex}[0]#m;
}
}
} elsif (-1<index ${$ex}[1],'g') {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#gi;
} else {
$result=1 if $string=~m#${$ex}[0]#g;
}
} else {
$result=1 if $string=~m#${$ex}[0]#;
} return $result,${$ex}[2]||'';
};
$sub; # Save Pound Sign
}
}
my $len_dir='';my $archive_flag=0;
if ($zipdir) {
my $ln=substr(${$_[1]},0,(index ${$_[1]},"\n"));
$zipdir=~s/\/+$//;
$len_dir=length " xx-xx-xx 00:00 $zipdir";
} elsif (!$ms_share && !$ms_domain && !$cygwin) {
$len_dir=(length $base_or_dest_folder)+2;
} elsif ($base_or_dest_folder=~/$cmd_handle->{_cygdrive_regex}/) {
my $tmp_basedest=$base_or_dest_folder;
$tmp_basedest=~s/$cmd_handle->{_cygdrive_regex}//;
substr($tmp_basedest,0,1)=unpack('a1',$tmp_basedest).':';
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$tmp_basedest/";
} elsif ($ms_share) {
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length
".Directory.of$d$_[3].$_[4].$base_or_dest_folder";
$len_dir=$len_dir-2
if substr($base_or_dest_folder,-2) eq '/.';
} elsif ($base_or_dest_folder=~/^\w:/) {
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$base_or_dest_folder/";
} elsif ($cygwin) {
my $tmp_bd=unpack('x1 a*',$base_or_dest_folder);
$tmp_bd=substr($tmp_bd,(index $tmp_bd,'/'));
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$tmp_bd/";
} else {
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$base_or_dest_folder/";
}
my $time='';my $files_flag='';my $mn=0;my $dy=0;
my $yr=0;my $hr=0;my $mt=0;my $pm='';my $size='';
my $file='';my $fchar='';my $u='';my $tm='';
my $g='';my $o='';my $topkey='';my $lchar_flag='';
my $excluded_parent_dir=0;my $included_parent_dir=0;
my $fileyr=0;my $bit=0;my $chmod='';
my $cur_dir_excluded=0;my $file_count=0;my $dofiles=0;
my @keys=();my $addbytes=0;my $nt5=0;
my $prevkey='';my $savekey='';my $savetotal=0;
$cmd_handle->{"_${bd}hash"}->{'/'}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
my $key='/';my $bytesize=0;my $total=0;
#$xxxnext=0;
#if (!$cygwin) {
#open(BK,">brianout.txt");
#print BK ${$_[1]};
#CORE::close BK;
#}
my @sublines=();my $lenflag=0;my $bs=0;my $bl=0;
#print "OUTPUT==>${$_[1]}<==\n";
FL: foreach my $line (split /^/, ${$_[1]}) {
my $parse=1;my $trak=0;
if ($savekey) {
#print "SAVEKEY=$savekey and LINE=$line<==\n";<STDIN>;
$key=$savekey;
$total=$savetotal;
$dofiles=0;
$savekey='';
$savetotal=0;
}
next if $line=~/^\s*$/;
WH: while ($parse || ($line=pop @sublines)) {
$parse=0;
$mn=0;$dy=0;$yr=0;$hr=0;
$mt='';$pm='';$size='';$file='';
if ($ms_share || $ms_domain
|| $cygwin) { # If Base is MSWin
unless ($lenflag) {
if (unpack('a1',$line) ne ' ') {
if (unpack('x24 a1',$line) eq '<') {
$bs=23;$bl=38;
} else {
$bs=24;$bl=39;
}
$lenflag=1;
} else { next }
}
$line=~tr/\0-\37\177-\377//d;
chomp($line);
if ($bl<length $line) {
if ($bs==23) {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @23 a14 @38 a*'
,$line);
$nt5=1;
$fileyr=$curcen.$yr;
$size=~s/^\s*//;
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};
} else {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @23 a14 @38 a*'
,$line);
$fileyr=$curcen.$yr;
$size=~s/^\s*//;
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};
}
} else {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,$line);
$nt5=1;
$fileyr=$curcen.$yr;
$size=~s/^\s*//;
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};
} else {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,$line);
$fileyr=$curcen.$yr;
$size=~s/^\s*//;
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};
}
}
} 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;
#}
next if $mn eq '' || $mn eq ' '
|| unpack('a1',$size) eq '<';
foreach my $pid_ts (@FA_Core::pid_ts) {
next FL if $file eq "rm${pid_ts}.bat"
|| $file eq "cmd${pid_ts}.bat"
|| $file eq "end${pid_ts}.flg"
|| $file eq "err${pid_ts}.txt"
|| $file eq "out${pid_ts}.txt";
}
if ($file eq '' && $mn ne ' D') { next }
} else { # Else Base is UNIX
#if ($line=~/entry_flash.swf/s && !$cygwin) {
#print "UNIX_LINE=$line<-- and KEY=$key and ZIPDIR=$zipdir\n";
#}
$fchar='';$u='';$g='';$o='';$chmod='';
chomp($line);
next if $line eq '';
my $lchar=substr($line,-1);
if ($lchar eq '*' || $lchar eq '/' || $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;
$lchar_flag=1;
} chop $line;
}
my $endofline=substr($line,-2);
if ($line=~s/^\s*([0-9]+)\s//) {
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "LS OUTPUT LINE=$line<==\n";
$cache->set($cache->{'key'},[0,
"LS OUTPUT LINE=$line<==\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"LS OUTPUT LINE=$line<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$bytesize=$1;
unless ($zipdir) {
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);
} elsif ($bytesize==0) {
$fchar='/';
}
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "ADDING BYTES TO TOTAL ==>$bytesize<==\n";
$cache->set($cache->{'key'},[0,
"ADDING BYTES TO TOTAL ==>$bytesize<==\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"ADDING BYTES TO TOTAL ==>$bytesize<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$addbytes+=$bytesize;
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "TOTAL BYTESIZE==>$addbytes<==\n";
$cache->set($cache->{'key'},[0,
"TOTAL BYTESIZE==>$addbytes<==\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"TOTAL BYTESIZE==>$addbytes<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$dofiles=1;
if ($endofline eq '..' || $endofline eq ' .') { next }
} else {
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);
if ($fchar eq 't') {
#print "TOTAL=$total and ADDBYTES=$addbytes and PREVKEY=$prevkey\n";
print $Net::FullAuto::FA_Core::LOG "TOTAL=$total and ADDBYTES=$addbytes and ",
"PREVKEY=$prevkey\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($dofiles && $total!=$addbytes) {
#print "WE HAVE A PROBLEM HOUSTON and KEY=$prevkey<--\n";
print $Net::FullAuto::FA_Core::LOG "WE HAVE A PROBLEM HOUSTON and KEY=$prevkey<--\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
@sublines=();
$savekey=$key;
$savetotal=unpack('x6 a*',$line);
$key=$prevkey;
die 'redo ls' if $key eq '/';
$addbytes=0;
my $ls_path=$Net::FullAuto::FA_Core::gbp->('ls',
$cmd_handle);
while (1) {
#print "LOOPING IN WHILE TO CORRECT LS -> KEY=$key\n";
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls --version") unless $lsgnu;
if ($lsgnu || (-1<index $stdout,'GNU')) {
$lsgnu=1;
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls -lRs --block-size=1 \'$key\'");
} else {
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls -lRs \'$key\'");
}
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
my $add_bytes=0;
#print "LS LOOPING STDOUT=$stdout\n";
foreach my $line (split /^/, $stdout) {
chomp($line);
next if $line eq '';
if ($line=~/^total /) {
$total+=unpack('x6 a*',$line);
next;
}
my $lchar=substr($line,-1);
if ($lchar eq '*' || $lchar eq '/'
|| $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;
$lchar_flag=1;
} chop $line;
}
my $endofline=substr($line,-2);
if ($line=~s/^\s*([0-9]+)\s//) {
my $bytesize=$1;
next if $bytesize!~/\d+/;
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);
$add_bytes+=$bytesize;
if ($endofline eq '..'
|| $endofline eq ' .') { next }
push @sublines, $line;
}
} last if $add_bytes==$total;
$total=0;
} next WH;
} else {
$total=unpack('x6 a*',$line);
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "TOTAL BYTES FINAL TALLY==>$total<==\n";
$cache->set($cache->{'key'},[0,
"TOTAL BYTES FINAL TALLY==>$total<==\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"TOTAL BYTES FINAL TALLY ==>$total<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (-1<index $total,'stdout:') {
$total=~s/^(\d+)(stdout:.*)$/$1/;
push @sublines, $2;
}
$addbytes=0;
}
}
}
my $per=lc("$u$g$0");
if ($fchar=~/[-dl]/ && (-1<index $per,'s'
|| -1<index $per,'t')) {
if (-1<index lc($u),'s') {
if (-1<index lc($g),'s') {
if (-1<index lc($o),'t') {
$bit=7;
} else {
$bit=6;
}
} else {
if (-1<index lc($o),'t') {
$bit=5;
} else {
$bit=4;
}
}
}
if ($bit<6 && -1<index lc($g),'s') {
if (-1<index lc($o),'t') {
$bit=3;
} else {
$bit=2;
}
} elsif ($bit<2 && -1<index lc($o),'t') {
$bit=1;
} else {
$bit=0;
}
$chmod=$bit.$Net::FullAuto::FA_Core::perms{$u};
$chmod.=$Net::FullAuto::FA_Core::perms{$g}.
$Net::FullAuto::FA_Core::perms{$o};
}
}
#if ($key=~/careers/) {
#if ($excluded_parent_dir) {
# print "KEY=$key and MODS=@modifiers and EXCLUDE_PARENT_DIR=$excluded_parent_dir\n";
#} elsif ($included_parent_dir) {
# print "KEY=$key and MODS=@modifiers and INCLUDE_PARENT_DIR=$included_parent_dir\n";
#}
#print "CYGWINNNNN=$cygwin and FCHAR=$fchar and MN=$mn and SIZE=$size and KEY=$key\n";<STDIN>;
#}
if ((!$cygwin && $fchar eq '/') || ($mn eq ' D')) {
#if ($key=~/bmicalculator/) {
# print "VERYGOOGGDDDDD - WE ARE HERE and MOD=$mod_dirs_flag and LINE=$line\n";<STDIN>;
#}
if ($mod_dirs_flag) {
foreach my $modif (@modifiers) {
@keys=();
next if ${$modif}[3] eq 'f';
if (${$modif}[3] eq 'd') {
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;
$key=unpack("x$len_dir a*",$line);
if ($ms_share || $ms_domain || $cygwin) {
$key=~tr/\\/\//;
}
$file_count=0;
$cur_dir_excluded=0;
}
if ($key ne '/') {
if (-1<index $key,'/') {
my $chkkey=$key;
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;
last if -1==index $chkkey,'/';
}
} else { unshift @keys, $key }
} unshift @keys, '/';
$Net::FullAuto::FA_Core::d_sub=regx_prog($modif,'d');
my $return=0;my $returned_modif='';
#if ($key eq '/') {
#print "KEY=$key and KEYSNOW33=@keys\n";
#}
($return,$returned_modif)=&$d_sub($key);
#if ($key eq '/') { # && $file=~/index/) {
#print "KEY=$key RETURN=$return and RETURNED_MODIF=$returned_modif\n";<STDIN>;
#}
if ($return) {
if (-1<index $returned_modif,'e') {
${$cmd_handle->{"_${bd}hash"}}{$key}
=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];
#print "BASE_DEST=$base_dest and EXCLUDEDKEY=$key\n";<STDIN>;
if ($base_dest eq 'BASE') {
$Net::FullAuto::FA_Core::base_excluded_dirs{$key}='-';
}
$excluded_parent_dir=$key;
$included_parent_dir='';
} else {
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
foreach my $key (@keys) {
if (${$cmd_handle->{"_${bd}hash"}}{$key}[0]
eq 'EXCLUDE') {
#print "HERE I AMMM777 AND KEY=$key\n";<STDIN>;
${$cmd_handle->{"_${bd}hash"}}{$key}[0]
='SOME';
}
}
$excluded_parent_dir='';
$included_parent_dir=$key;
}
} elsif ($excluded_parent_dir &&
length $excluded_parent_dir<length
$key && unpack("a".length $excluded_parent_dir,
$key) eq $excluded_parent_dir) {
#if ($key=~/bmicalculator/) {
#print "OUTHASH_EXCLUDED_PARENT_KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];
$included_parent_dir='';
} elsif ($included_parent_dir &&
length $included_parent_dir<length
$key && unpack("a".length $included_parent_dir,
$key) eq $included_parent_dir) {
#if ($key=~/bmicalculator/) {
#print "OUTHASH_INCLUDED_PARENT_KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
$excluded_parent_dir='';
} elsif ((-1<index ${$modif}[2],'i') &&
(-1==index ${$modif}[2],'e')) {
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];
$excluded_parent_dir='';
$included_parent_dir='';
} else {
#if ($key=~/bmicalculator/) {
#print "OUTHASH_ELSE_KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
$excluded_parent_dir='';
$included_parent_dir='';
}
} else {
#if ($key=~/bmicalculator/) {
#print "YEERRRRR=$key\n";<STDIN>;
#}
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;
$key=unpack("x$len_dir a*",$line);
#print "KEYYYYYYYYYYYYYY=$key and LINE=$line and LENDIR=$len_dir\n";sleep 2;
#print "KEYHERERERERER2222222 and LINE=$line\n" if $key eq 'member/my_health/calculators/bmicalculator/images';
#<STDIN> if $key eq 'member/my_health/calculators/bmicalculator/images';
if ($ms_share || $ms_domain || $cygwin) {
$key=~tr/\\/\//;
}
$file_count=0;
$cur_dir_excluded=0;
}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
}
}
} else {
if ($mod_files_flag &&
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
eq 'DEPLOY_SOMEFILES_OF_CURDIR') {
#if ($key=~/bmicalculator/) {
#print "HERE I AMMM888 AND KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[0]='SOME';
}
#print "WHAT IS THE LEN_DIR=$len_dir and LINE=$line<==\n";
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;
$key=unpack("x$len_dir a*",$line);
#print "KEYHERERERERER33333 and LINE=$line and len_dir=$len_dir and KEY=$key<==\n";sleep 5;# if $key eq 'member/my_health/calculators/bmicalculator/images';
#<STDIN> if $key eq 'member/my_health/calculators/bmicalculator/images';
if ($ms_share || $ms_domain || $cygwin) {
$key=~tr/\\/\//;
}
$file_count=0;
$cur_dir_excluded=0;
}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
}
} elsif ((!$cygwin && $fchar eq '-' || $zipdir) ||
($cygwin && $mn ne ' D' && unpack('a5',$size) ne '<DIR>')) {
$file_count++;
#if ($key eq '/') {
#print "UNIXXXYYLINE=$line and CYGWINNNN=$cygwin and MN=$mn and SIZE=$size and FILE=$file and KEY=$key and ZIPDIR=$zipdir\n";<STDIN>;
#}
if (!$cygwin && ($fchar eq '-' || $fchar eq 'l')) {
my $up=unpack('x10 a*',$line);
$up=~s/^[.+ ]?\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)$/$1/;
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;
my $yr='';
if ($mn=~/(\d\d\d\d)-(\d\d)-(\d\d)/) {
$file=$tm;
$tm=$dy;
$yr=$1;$mn=$2;$dy=$3;
$dy='0'.$dy if $dy=~/^\d$/;
} 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;
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\"");
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
my $lchar=substr($stdout,-1);
if ($lchar eq '*' || $lchar eq '/'
|| $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;
$lchar_flag=1;
} chop $line;
}
push @sublines, $stdout;
next WH;
} else {
substr($up,-(length $file))='';
$up=~/\s+(\d+)\s+(\w\w\w)\s+(\d+)\s+(\d+:?\d+).*$/;
$size=$1;$mn=$2;$dy=$3;$tm=$4;
$dy='0'.$dy if $dy=~/^\d$/;
}
}
$mn=$Net::FullAuto::FA_Core::month{$mn} if length $mn==3;
$fileyr=0;$hr=0;$mt=0;
if (length $tm==4) {
$fileyr=$tm;$hr='--';$mt='--';
} elsif ($yr) {
($hr,$mt)=unpack('a2 @3 a2',$tm);
$fileyr=$yr;
} else {
($hr,$mt)=unpack('a2 @3 a2',$tm);
$yr=unpack('x1 a2',"$Net::FullAuto::FA_Core::thisyear");
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
}
}
}
$file=s/ -> .*$// if -1<index $file,' -> ';
} elsif ($zipdir) {
$line=~s/^\s//;
my $fullfile='';
($dy,$tm,$fullfile)=split / +/, $line;
($mn,$dy,$yr)=split '-', $dy;
($hr,$mt)=split ':', $tm;
$file=substr($fullfile,(rindex $fullfile,'/')+1);
if ($fullfile ne $zipdir.'/'.$key.'/'.$file) {
my @kdirs=($key);
if (-1<index $key,'/') {
@kdirs=split '/',$key;
}
if ($#kdirs==0) {
$key='/';
} else {
while (pop @kdirs) {
my $di=join '/', @kdirs;
if ($fullfile eq $zipdir.'/'.$di.'/'.$file) {
$key=$di;
last;
}
}
}
}
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
$size=$bytesize;
}
#if ($key eq '/') {
#print "CYGWINNNNN\n" if $cygwin;
#print "WITH CAREER AND FILE DIR=$key and FILE=$file and MODFILEFLAG=$mod_files_flag\n";#<STDIN>;
#}
if ($mod_dirs_flag && ${$cmd_handle->{"_${bd}hash"}}{$key}[0]
eq 'EXCLUDE') {
#if ($key eq '/') {
#print "HERE WE ARE EXCLUDING and MODDIR=$mod_dirs_flag and OUTHASHENTRY=",${$cmd_handle->{"_${bd}hash"}}{"$key"}[0],"\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];
$num_of_excluded++;
} elsif ($mod_files_flag) {
foreach my $modif (@modifiers) {
if (${$modif}[3] eq 'f') {
$Net::FullAuto::FA_Core::f_sub=regx_prog($modif,'f');
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key);
my $fileyr=0;
#if ($key eq '/') {
# print "FILE=$file and RETURN=$return and MODIF=$returned_modif\n";
# <STDIN>;
#}
if ($return || (-1<index $returned_modif,'e')) {
if ($return && (-1<index $returned_modif,'e')) {
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];
$Net::FullAuto::FA_Core::base_excluded_files{$key}
{$file}='-';
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_SOMEFILES_OF_CURDIR') {
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
='DEPLOY_NOFILES_OF_CURDIR';
}
$num_of_excluded++;
$cur_dir_excluded++;
} else {
if (!$ms_share && !$ms_domain && !$cygwin) {
my $up=unpack('x10 a*',$line);
my $rx=qr/\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)/;
$up=~s/^[.+ ]?$rx$/$1/;
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;
$mn=$Net::FullAuto::FA_Core::month{$mn}
if length $mn==3;
$fileyr=0;my $hr=0;my $mt='';
if (length $tm==4) {
$fileyr=$tm;$hr='--';$mt='--';
} else {
($hr,$mt)=unpack('a2 @3 a2',$tm);
my $yr=unpack('x1 a2',
$Net::FullAuto::FA_Core::thisyear);
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth <
$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=
$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth
==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=
$Net::FullAuto::FA_Core::curcen
.$yr;
}
}
}
$file=~s/\s*$//g;
next if !$file;
} $chmod=" $chmod" if $chmod;
my $dt=(3==length $mn)?$Net::FullAuto::FA_Core::month{$mn}:$mn;
#if ($file eq 'Print_Preview.gif') {
#print "GOOOOOOODDDDDFILE===$file and KEY=$key and HR=$hr\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$dt $dy $hr $mt $fileyr $size$chmod" ];
#if ($key eq '/') {
#print "WE JUST DID OUTHASH and KEY=$key and $#{[keys %{$cmd_handle->{"_${bd}hash"}}]}\n";
#}
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_NOFILES_OF_CURDIR') {
${$cmd_handle->{"_${bd}hash"}}{$key}[2]=
'DEPLOY_SOMEFILES_OF_CURDIR';
}
$num_of_included++;
}
} else {
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_SOMEFILES_OF_CURDIR') {
if ($file_count==++$cur_dir_excluded) {
#if ($key eq '/') {
#print "HERE WE ARE and KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
='DEPLOY_NOFILES_OF_CURDIR'
}
}
$num_of_excluded++;
}
}
}
} elsif ($hr=~/^\d\d$|^--$/) {
$chmod=" $chmod" if $chmod;
#print "ALL GOING==>$mn $dy $hr $mt $fileyr $size$chmod<== and FILE=$file and FILEYR=$fileyr<--\n";
#if ($file eq 'Print_Preview.gif') {
#print "GOOOOOOODDDDDFILE222===$file and KEY=$key and STRING=$mn $dy $hr $mt $fileyr $size$chmod\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$mn $dy $hr $mt $fileyr $size$chmod" ];
$num_of_included++;
} else {
my $fileyr=0;
if (!$cygwin) {
if ($zipdir) {
$line=~s/^\s//;
($dy,$tm,$file)=split / +/, $line;
($mn,$dy,$yr)=split '-', $dy;
($hr,$mt)=split ':', $tm;
$file=substr($file,(rindex $file,'/')+1);
} else {
my $up=unpack('x10 a*',"$line");
$up=~s/^[.+ ]?\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)$/$1/;
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;
my $yr='';$fileyr='';
if ($mn=~/(\d\d\d\d)-(\d\d)-(\d\d)/) {
$fileyr=$1;
$file=$tm;
$tm=$dy;
$mn=$2;$dy=$3;
}
}
$mn=$Net::FullAuto::FA_Core::month{$mn}
if length $mn==3;
my ($hr,$mt)='';
if (length $tm==4) {
$fileyr=$tm;$hr='--';$mt='--';
} elsif (!$fileyr) {
($hr,$mt)=unpack('a2 @3 a2',$tm);
$yr=unpack('x1 a2',$Net::FullAuto::FA_Core::thisyear);
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
}
}
}
$file=~s/\s*$//g;
$file=s/ -> .*$// if -1<index $file,' -> ';
} $chmod=" $chmod" if $chmod;
my $dt=(3==length $mn)?$Net::FullAuto::FA_Core::month{$mn}:$mn;
#if ($file eq 'Print_Preview.gif') {
#print "GOOOOOOODDDDDFILE222===$file and KEY=$key and HR=$hr\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$mn $dy $hr $mt $fileyr $size$chmod" ];
#if ($key=~/pdf|common|stylesheet|header/ && $file=~/index/ && !$cygwin) {
#print "JUST UPDATED OUTHASH=",@{${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}},"\n";<STDIN>;
#}
$num_of_included++;
}
}
}
}
};
if ($@) {
#print "DO WE HAVE AN ERROR AND WHAT IS IT=$@\n";<STDIN>;
return '','redo ls' if unpack('a7',$@) eq 'redo ls';
if (unpack('a10',$@) eq 'The System') {
return '',$@;
} else {
my $hostlabel='localhost';
if ($cmd_handle->{_hostlabel}->[0] ne "__Master_${$}__") {
$hostlabel=$cmd_handle->{_hostlabel}->[0];
}
my $die="FATAL ERROR! - The System $hostlabel Returned"
."\n the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n ".$@;
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return '', $die;
}
} ${$cmd_handle->{"_${bd}hash"}}{"___%EXCluD%E--NUMOFFILES"}=$num_of_included;
${$cmd_handle->{"_${bd}hash"}}{"___%EXCluD%E--NUMOFBASEFILES"}
=$num_of_included+$num_of_excluded;
return '','';
}
package Rem_Command;
# Handle INT SIGNAL interruption
# local $SIG{ INT } = sub{ print "I AM HERE" };
sub new {
print "Rem_Command::new CALLER=",caller,"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"Rem_Command::new CALLER=",(caller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
our $timeout=$Net::FullAuto::FA_Core::timeout;
our $test=$Net::FullAuto::FA_Core::test;
my $self = { };
my $class=ref $_[0]||$_[0];
my $hostlabel=$_[1];
my $new_master=$_[2]||'';
my $_connect=$_[3]||'';
my $cache='';
my $override_login_id='';
my $berkeley_db_path='';
if (defined $_[4]) {
if (-1<index $_[4],'Cache::FileCache') {
$cache=$_[4];
} elsif ((-1<index $_[4],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[4]->chi_root_class)) {
$cache=$_[4];
} else {
$override_login_id=$_[4];
}
}
my $looped=$_[5]||0;
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my $chk_id='';
if ($su_id) { $chk_id=$su_id }
elsif ($login_id) { $chk_id=$login_id }
else { $chk_id=&Net::FullAuto::FA_Core::username() }
my $cmd_handle='';my $work_dirs='';my $cmd_type='';
my $ftm_type='';my $stderr='';my $cmd_pid='';my $shell='';
my $shell_pid=0;my $cygdrive='';my $homedir='';
($cmd_handle,$work_dirs,$homedir,$uname,$cmd_type,
$ftm_type,$stderr,$ip,$hostname,$cmd_pid,$shell_pid,
$cygdrive,$shell)=&cmd_login(
$hostlabel,$new_master,$_connect,$override_login_id,
$cache,$looped);
if ($stderr) {
$stderr=~s/(at .*)$/\n\n $1/s;
my $die="\n FATAL ERROR! - $stderr";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return $cmd_handle,$die if wantarray;
&Net::FullAuto::FA_Core::handle_error($die);
}
$self->{_hostlabel}=[ $hostlabel,'' ];
$self->{_cmd_handle}=$cmd_handle;
$self->{_cmd_type}=$cmd_type;
$self->{_ftp_type}=$ftm_type;
$self->{_connect}=$_connect;
$self->{_work_dirs}=$work_dirs;
$self->{_ip}=$ip;
$self->{_uname}=$uname;
$self->{_luname}=$^O;
$self->{_cmd_pid}=$cmd_pid;
$self->{_sh_pid}=$shell_pid;
$self->{_shell}=$shell;
$self->{_homedir}=$homedir.'/';
if ($cygdrive) {
$self->{_cygdrive}=$cygdrive;
$self->{_cygdrive_regex}=qr/^$cygdrive\//;
}
bless($self,$class);
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$chk_id"}=$self;
return $self,''
}
sub handle_error
{
my @topcaller=caller;
print "Rem_Command::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "Rem_Command::handle_error() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return &Net::FullAuto::FA_Core::handle_error(@_);
}
sub close
{
my @topcaller=caller;
print "Rem_Command::close() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "Rem_Command::close() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];
my $kill_arg=($^O eq 'cygwin')?'f':9;
if (defined fileno $self->{_cmd_handle}) {
my $gone=1;my $was_a_local=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
CM: while (defined fileno $self->{_cmd_handle}) {
$self->{_cmd_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('printf').
"printf $funkyprompt");
while (my $line=$self->{_cmd_handle}->get) {
print $Net::FullAuto::FA_Core::LOG "cleanup() LINE_3=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last if $line=~/logout|221\sGoodbye/sx;
if ($line=~/_funkyPrompt_$/s) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});
$self->{_cmd_handle}->print(' exit');
} elsif (($line=~/Killed|_funkyPrompt_/s) ||
($line=~/[:\$%>#-] ?$/s) ||
($line=~/sion denied.*[)][.]\s*$/s)) {
print $Net::FullAuto::FA_Core::LOG "cleanup() SHOULD BE LAST CM=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$gone=0;last CM;
} elsif (-1<index $line,
'Connection to localhost closed') {
$was_a_local=1;
last CM;
} elsif ($line=~/Connection.*closed/s) {
last CM;
}
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last CM if $count++==20;
} else { $count=0 }
if (-1<index $line,'assword:'
|| -1<index $line,'Permission denied') {
$self->{_cmd_handle}->print("\004");
}
}
}
};
if ($@) {
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';
} else { $self->{_cmd_handle}->close();die "$@ $!" }
}
} $self->{_cmd_handle}->close();
delete $self->{_cmd_handle};
return 0;
}
sub print
{
my @topcaller=caller;
print "Rem_Command::print() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "Rem_Command::print() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=shift @_;
return $self->{_cmd_handle}->print(@_);
}
sub prompt
{
my @topcaller=caller;
print "Rem_Command::prompt() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "Rem_Command::prompt() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=shift @_;
return $self->{_cmd_handle}->prompt(@_);
}
sub get
{
my @topcaller=caller;
print "Rem_Command::get() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"Rem_Command::get() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];
my $stderr="ERROR MESSAGE! :"
."\n\n The $self->{_connect} method does"
."\n not enable file transfer get()"
."\n functionality. To do file transfer"
."\n transfer use a method such as"
."\n \'connect_secure\' or \'connect_host\'"
."\n etc.\n\n";
if (wantarray) {
return '',"\n\n ".(caller(1))[3]." $stderr at ".
$topcaller[1]." - Line $topcaller[2].\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
sub put
{
my @topcaller=caller;
print "Rem_Command::put() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"Rem_Command::put() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];
my $stderr="ERROR MESSAGE! :"
."\n\n The $self->{_connect} method does"
."\n not enable file transfer put()"
."\n functionality. To do file transfer"
."\n transfer use a method such as"
."\n \'connect_secure\' or \'connect_host\'"
."\n etc.\n\n";
if (wantarray) {
return '',"\n\n ".(caller(1))[3]." $stderr at ".
$topcaller[1]." - Line $topcaller[2].\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
sub cmd_login
{
my @topcaller=caller;
print "\nINFO: Rem_Command::cmd_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::cmd_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $hostlabel=$_[0];
my $new_master=$_[1]||0;
my $_connect=$_[2]||'';
my $override_login_id=$_[3]||'';
my $kill_arg=($^O eq 'cygwin')?'f':9;
my $cache=$_[4]||$main::cache||'';
my $looped=$_[5]||0;
my $timeout=$Net::FullAuto::FA_Core::timeout;
print "WE GOT HOSTLABEL=$hostlabel<==\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"WE GOT HOSTLABEL=$hostlabel<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cdtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
if ($override_login_id) {
print "SHIT\n";
$login_id=$override_login_id;
$su_id='';
}
print "WE ARE BACK FROM LOOKUP and IP=$ip and HOSTNAME=$hostname<== and PASSWORD=$password<==\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "WE ARE BACK FROM LOOKUP<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$cdtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$cdtimeout) {
$cdtimeout=$timeout if !$cdtimeout;
}
unless ($login_id) {
if (defined $Net::FullAuto::FA_Core::usrname) {
$login_id=$Net::FullAuto::FA_Core::usrname;
} else {
$login_id=Net::FullAuto::FA_Core::username();
}
}
my $cmd_handle='';my $work_dirs='';my $cmd_type='';
my $ftm_type='';my $use_su_login='';my $id='';my $cygwin='';
my $su_login='';my $die='';my $login_passwd='';my $ms_su_id='';
my $ms_ms_domain='';my $ms_ms_share='';my $ms_login_id='';
my $ms_hostlabel='';my $ms_host='';
my $cmd_errmsg='';my $host='';my $output='';my $shell_pid=0;
my $retrys=0;my $login_tries=0;my $cmd_pid='';my $shell='';
my $su_scrub='';my @connect_method=();my $homedir='';
my ($stdout,$stderr)=('','');
if (exists $Hosts{$hostlabel} && exists
$Hosts{$hostlabel}->{'password'}) {
$login_passwd=$Hosts{$hostlabel}->{'password'};
} elsif (exists $Hosts{$hostlabel} &&
exists $Hosts{$hostlabel}->{'label'} &&
(lc($Hosts{$hostlabel}->{'label'}) eq 'mozrepl' ||
$Hosts{$hostlabel}->{'label'} eq 'Firefox MozRepl') ||
$Hosts{$hostlabel}->{'label'} eq 'Localhost Shell') {
} elsif ($hostlabel!~/__Master_${$}__/ && !$identityfile) {
$determine_password->('',0,$hostlabel,$password);#GGGGGG
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','');
}
$host=($use eq 'ip')?$ip:$hostname;
$host='localhost' if exists $same_host_as_Master{$host}
&& !exists $Hosts{$hostlabel}{'sshport'};
if ($host eq 'localhost' && exists $Hosts{$hostlabel}
&& exists $Hosts{$hostlabel}->{'label'}
&& $Hosts{$hostlabel}->{'label'} ne 'localhost'
&& $_connect eq 'connect_telnet') {
@connect_method=('telnet');
} elsif ($_connect eq 'connect_shell') {
@connect_method=('shell');
} elsif ($host eq 'localhost' &&
exists $Hosts{"__Master_${$}__"}{'Local'}) {
my $loc=$Hosts{"__Master_${$}__"}{'Local'};
unless ($loc eq 'connect_ssh'
|| $loc eq 'connect_telnet'
|| $loc eq 'connect_ssh_telnet'
|| $loc eq 'connect_telnet_ssh') {
my $die="\n FATAL ERROR - \"Local\" has "
."*NOT* been Properly\n Defined in the "
."\"$Net::FullAuto::FA_Core::fa_host\" File.\n"
." This "
."Element must have one of the following\n"
." Values:\n\n "
." 'connect_ssh'or 'connect_telnet'\n "
." 'connect_ssh_telnet' or\n "
." 'connect_telnet_ssh'\n\n"
." \'$loc\' is INCORRECT.\n\n";
print $Net::FullAuto::FA_Core::LOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} elsif ($loc eq 'connect_ssh') {
$_connect=$loc;
@connect_method=('ssh');
} elsif ($loc eq 'connect_telnet') {
$_connect=$loc;
@connect_method=('telnet');
} elsif ($loc eq 'connect_ssh_telnet') {
$_connect=$loc;
@connect_method=('ssh','telnet');
} else {
$_connect=$loc;
@connect_method=('telnet','ssh');
}
} else { @connect_method=@{$cmd_cnct} }
my $previous_method='';my $sshloginid='';
my $ignore='';my $preferred=0;my $outpt='';my $cygdrive='';my $prompt='';
while (1) {
undef $@;
eval {
if ($hostlabel eq "__Master_${$}__" && !$new_master) {
$cmd_handle=$Net::FullAuto::FA_Core::localhost->{_cmd_handle};
$cmd_pid=$Net::FullAuto::FA_Core::localhost->{_cmd_pid};
$shell_pid=$Net::FullAuto::FA_Core::localhost->{_sh_pid};
} else {
print $Net::FullAuto::FA_Core::LOG
"GOINGKKK FOR NEW CMD_HANDLE and CONNECT_METH=@connect_method<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
WH: while (1) {
my $rm_cnt=-1;
CM3: foreach my $connect_method (@connect_method) {
$rm_cnt++;
if ($previous_method && !$preferred) {
if ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet &&
(-1==index $stderr,'/dev/tty: No') &&
!$main::aws) {
print "Warning (4), Preferred Connection ",
"$previous_method Failed\n";
$cache->set($cache->{'key'},[0,
"Warning, Preferred Connection ".
"$previous_method Failed\n"])
if $cache;
}
$preferred=1;
} else { $previous_method=$connect_method }
#$previous_method=$connect_method;
if (lc($connect_method) eq 'shell') {
$cmd_type='shell';
print "\nSHELL CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),'bash',
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSHELL CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),'bash',
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').'bash',
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
$uname=$^O;
$homedir=File::HomeDir->my_home.'/';
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cdtimeout);
$cmd_handle->telnetmode(0);
$cmd_handle->binmode(1);
$cmd_handle->output_record_separator("\r");
$cmd_handle->prompt("/_funkyPrompt_\$/");
$cmd_handle->print(
" export PS1=_funkyPrompt_;unset PROMPT_COMMAND");
$cmd_handle->print();my $out='';
while (my $line=$cmd_handle->get(Timeout=>$timeout)) {
$out.=$line;
last if $out=~/_funkyPrompt_\s*$/;
select(undef,undef,undef,0.02); # sleep for 1/50th
# second;
$cmd_handle->print();
}
$cmd_handle->print("echo $$");
while (my $line=$cmd_handle->get(Timeout=>$timeout)) {
last if $shell_pid=~s/\s*_funkyPrompt_$//s;
$shell_pid=$line;
select(undef,undef,undef,0.02); # sleep for 1/50th
# second;
$cmd_handle->print();
}
$shell_pid=~s/^.*\n(\d+)\s*$/$1/s;
$work_dirs=&Net::FullAuto::FA_Core::work_dirs(
$transfer_dir,$hostlabel,{ _cmd_handle=>$cmd_handle,
_uname=>$uname },$cmd_type,$cygdrive,$_connect);
if ($^O eq 'cygwin') {
&Net::FullAuto::FA_Core::acquire_fa_lock(8712);
($cygdrive,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
$Net::FullAuto::FA_Core::gbp->('mount')."mount -p");
&Net::FullAuto::FA_Core::release_fa_lock(8712);
$cygdrive=~s/^.*(\/\S+).*$/$1/s;
}
return $cmd_handle,$work_dirs,$homedir,$uname,$cmd_type,
$ftm_type,$die,$ip,$hostname,$cmd_pid,$shell_pid,
$cygdrive,$shell;
} elsif (lc($connect_method) eq 'telnet') {
eval {
my $telnetpath=$Net::FullAuto::FA_Core::gbp->('telnet');
my $telnetport='';
if (exists $Hosts{$hostlabel}->{'telnetport'}) {
$telnetport=$Hosts{$hostlabel}->{'telnetport'};
}
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");
} 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 "CMD_PIDTELNETNNNNNNN=$cmd_pid<====\n";
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cdtimeout);
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
}
$cmd_handle->telnetmode(0);
$cmd_handle->binmode(1);
$cmd_handle->output_record_separator("\r");
$cmd_handle->timeout($cdtimeout);
};
if ($@) {
#if ($rm_cnt==$#connect_method) {
if (1<=$#connect_method) {
undef $@;next;
} else {
my $die=$@;undef $@;
die $die;
}
}
while (my $line=$cmd_handle->get) {
#print "TELNET_CMD_HANDLE_LINE=$line\n";
print $Net::FullAuto::FA_Core::LOG
"TELNET_CMD_HANDLE_LINE=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $showline=$line;
$showline=~tr/\0-\11\13-\37\177-\377//d;
chomp($showline);
$showline=~tr/\12/\033/;
$showline=~tr/\33//s;
$showline=~tr/\33/\12/;
$showline=~s/^\12//s;
$showline=~s/login.*$//s;
if (!$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug) {
print $showline;
$cache->set($cache->{'key'},[0,$showline])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG $showline
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$line=~tr/\0-\37\177-\377//d;
chomp($line);
if (-1<index $line,'Connection refused') {
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($cmd_pid);
if ($su_id) {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.$Net::FullAuto::FA_Core::pcnt};
} else {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.$Net::FullAuto::FA_Core::pcnt};
}
my $lchl=lc($hostlabel);
$Net::FullAuto::FA_Core::firefox||='';
if (($^O eq 'cygwin') && (-1<index $lchl,'mozrepl')
&& !($Net::FullAuto::FA_Core::firefox)) {
unshift @connect_method,'telnet';
# Let's look for Firefox
my $firefox=
'REG QUERY "HKEY_LOCAL_MACHINE\\SOFTWARE\\'.
'Mozilla\\Mozilla FireFox" 2>&1';
($firefox,$stderr)=
&Net::FullAuto::FA_Core::cmd($firefox);
$firefox=~tr/\0-\11\13-\37\177-\377//d;
chomp($firefox);
$firefox=~s/^\s*//;
if ($firefox=~/^Error:/) {
my $die=" Cannot Locate a "
."Mozilla FireFox installation"
."\n "
."needed for FullAuto repl() "
."functionality:\n"
."\n ".$firefox;
&Net::FullAuto::FA_Core::handle_error($die);
}
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
$firefox=~
s/^.*CurrentVersion\s*REG_SZ\s*(.*?)\n.*$/$1/s;
$firefox=
'REG QUERY "HKEY_LOCAL_MACHINE\\SOFTWARE\\'.
"Mozilla\\Mozilla Firefox\\$firefox\\Main\"".
' 2>&1';
($stdout,$stderr)=
&Net::FullAuto::FA_Core::cmd(
'ps -W | grep firefox');
my $fireflag=0;
if (-1<index $stdout,'firefox') {
$fireflag=1;
}
($firefox,$stderr)=
&Net::FullAuto::FA_Core::cmd($firefox);
if ($firefox=~/^Error:/) {
my $die=" Cannot Locate a "
."Mozilla FireFox installation"
."\n "
."needed for FullAuto repl() "
."functionality:\n"
."\n ".$firefox;
&Net::FullAuto::FA_Core::handle_error($die);
}
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
$firefox=~tr/\0-\11\13-\37\177-\377//d;
chomp($firefox);
$firefox=~s/^.*PathToExe\s*REG_SZ\s*(.*)\s*$/$1/s;
$firefox=~s/\s*$//s;
my $winff=$firefox;
($firefox,$stderr)=&Net::FullAuto::FA_Core::cmd(
"cygpath \"$firefox\"");
$Net::FullAuto::FA_Core::firefox=$firefox;
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
# Let's look for MozRepl
my $have_mozrepl=0;
my $up=$ENV{'USERPROFILE'}||'';
if (-1<index $up,'Documents') {
$up.="\\Application Data\\Mozilla\\".
"Firefox\\Profiles\\";
} else {
$up.="\\AppData\\Roaming\\Mozilla\\".
"Firefox\\Profiles\\";
}
($up,$stderr)=&Net::FullAuto::FA_Core::cmd(
"cygpath \"$up\"");
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
my @dirs=();
if (-e $up) {
opendir(DIR,$up);
@dirs = readdir(DIR);
closedir(DIR);
}
if (-1<$#dirs) {
HM: foreach my $profile (@dirs) {
next if $profile eq '.';
next if $profile eq '..';
if (-e $up."/$profile/extensions") {
opendir(DIR,$up."/$profile/extensions");
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
if (-1<index $file,'mozrepl') {
$have_mozrepl=1;
last HM;
}
}
}
}
}
unless ($have_mozrepl) {
eval {
die;
};
my $path=$@;
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;
chomp($path);
my $cdr='';
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
"cygpath -w \"$path\"");
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
$cdr=~s/\\/\\\\/g;
$winff=~s/\\/\\\\/g;
my $progpath=substr($0,0,(rindex $0,'/')+1);
my $mc=$progpath.'install_mozrepl_plugin '.
"\"$winff\""." ${cdr}mozrepl-1.1-fx.xpi";
#my $mystdout='';
my ($stdout_capture,$stderr_capture)=('','');
($stdout_capture,$stderr_capture)=
Capture::Tiny::capture {
system($mc);
};
}
my $fcmd="\"${firefox}\" -new-instance -repl ".
"http://www.FullAuto.com ".
"1>$localhost->{_work_dirs}->{_tmp}".
"repl_out.txt &";
unless ($fireflag) {
my $ro=$localhost->{_work_dirs}->{_tmp}.
"repl_out.txt";
unlink $ro if -e $ro;
my ($stdout_capture,$stderr_capture)=('','');
($stdout_capture,$stderr_capture)=
Capture::Tiny::capture {
system($fcmd);
};
my $cat_=$Net::FullAuto::FA_Core::gbp->('cat');
foreach (1..30) {
my $out=`${cat_}cat $ro`;
if (-1<index $out,'MOZREPL : Listening') {
unlink $ro;
$previous_method=0;
$Net::FullAuto::FA_Core::ff_flag=1;
next WH;
}
sleep 1;
}
$fcmd="\"${firefox}\" -new-instance -repl ".
"http://www.FullAuto.com".
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm(30);
($stdout,$stderr)=$localhost->cmd($fcmd);
};alarm(0);
$stderr=$@ if $@;
&Net::FullAuto::FA_Core::handle_error($stderr);
} else {
my ($stdout_capture,$stderr_capture)=('','');
($stdout_capture,$stderr_capture)=
Capture::Tiny::capture {
system($fcmd);
};
}
}
if (1<=$#connect_method) {
$stderr=$line;
next CM3;
} else {
&Net::FullAuto::FA_Core::handle_error($line);
}
}
if (-1<index $line,'CYGWIN') {
if ($su_id) {
if ($su_id ne $login_id) {
$login_id=$su_id;
} else { $su_id='' }
my $value=$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}=
$value;
}
$uname='cygwin';
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'Uname'}='cygwin';
$cygwin=1;
} elsif (-1<index $line,'AIX') {
$uname='aix';
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'Uname'}='aix';
}
last if $line!~/Last login/i &&
$line=~/login[: ]*$|username[: ]*$/i;
if ($line=~/(repl\d*)>\s*$/s) {
$shell=$1;
$cmd_handle->prompt("/$shell> \$/");
return $cmd_handle,$work_dirs,$uname,
$cmd_type,$ftm_type,$die,$ip,$hostname,
$cmd_pid,$shell_pid,$cygdrive,$shell;
}
}
if ($cmd_errmsg &&
(-1==index $cmd_errmsg,'Cannot su to')) {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'',$cmd_errmsg)
} else {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','')
}
$cmd_handle->print($login_id);
if ($cmd_handle->errmsg) {
&Net::FullAuto::FA_Core::handle_error(
$cmd_handle->errmsg);
} $cmd_type='telnet';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect });
if ($stderr && $rm_cnt!=$#connect_method) {
$cmd_handle->close;
next CM3;
} last
} elsif (lc($connect_method) eq 'ssh') {
if (exists $Hosts{$hostlabel}{'Proxy'}) {
my $error='';
($proxy,$error)=
Net::FullAuto::FA_Core::connect_secure(
$Hosts{$hostlabel}{'Proxy'});
}
$sshloginid=($use_su_login)?$su_id:$login_id;
eval {
my $sshport='';
if (exists $Hosts{$hostlabel}{'sshport'}) {
$sshport=$Hosts{$hostlabel}{'sshport'};
}
if ($proxy &&
exists $Hosts{$hostlabel}{'IdentityFile'} &&
$Hosts{$hostlabel}{'IdentityFile'}) {
($stdout,$stderr)=$proxy->cmd(
"ls -l ".$Hosts{$hostlabel}{'IdentityFile'});
if ($stderr) {
($stdout,$stderr)=$proxy->cwd("~");
($stdout,$stderr)=$proxy->put(
$Hosts{$hostlabel}{'IdentityFile'});
}
}
if ($sshport) {
if (exists $Hosts{$hostlabel}{'IdentityFile'} &&
$Hosts{$hostlabel}{'IdentityFile'}) {
my $i=$Hosts{$hostlabel}{'IdentityFile'};
if (-1<index $stderr,'/dev/tty: No') {
my $v='v';
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -i $i $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -i $i $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -$v -i $i $sshloginid\@$host",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} elsif ($proxy) {
my $v='v';
print "\nSSH PROXY CONNECT: ",
"ssh -$v -i$i -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH PROXY CONNECT: ",
"ssh -$v -i$i -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$cmd_handle=$proxy->{_cmd_handle};
$cmd_handle->print("ssh -$v -i$i ".
"-p$sshport $sshloginid\@$host");
$cmd_pid=$proxy->{_cmd_pid};
} else {
my $v='v';
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -i$i -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -i$i -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $li=$sshloginid;
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -$v -i$i -p$sshport $li\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");
}
} else {
if (-1<index $stderr,'/dev/tty: No') {
my $v='v';
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -p$sshport $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -p$sshport $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -$v -p$sshport $sshloginid\@$host",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} elsif ($proxy) {
my $v='v';
if (exists $Hosts{$hostlabel}{'IdentityFile'}
&& $Hosts{$hostlabel}{'IdentityFile'}) {
my $i=$Hosts{$hostlabel}{'IdentityFile'};
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
print "\nSSH PROXY CONNECT: ",
"ssh -$v $id$i -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH PROXY CONNECT: ",
"ssh -$v $id$i -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,
'*';
$cmd_handle=$proxy->{_cmd_handle};
$cmd_handle->print("ssh -$v $id$i ".
"-p$sshport $sshloginid\@$host");
$cmd_pid=$proxy->{_cmd_pid};
} else {
print "\nSSH PROXY CONNECT: ",
"ssh -$v -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH PROXY CONNECT: ",
"ssh -$v -p$sshport ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,
'*';
$cmd_handle=$proxy->{_cmd_handle};
$cmd_handle->print("ssh -$v ".
"-p$sshport $sshloginid\@$host");
$cmd_pid=$proxy->{_cmd_pid};
}
} else {
my $v='v';
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -p$sshport $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v -p$sshport $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh","-$v","-p$sshport",
"$sshloginid\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");
}
}
} elsif (exists $Hosts{$hostlabel}{'IdentityFile'}
&& $Hosts{$hostlabel}{'IdentityFile'}) {
my $i=$Hosts{$hostlabel}{'IdentityFile'};
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
if (-1<index $stderr,'/dev/tty: No') {
my $v='v';
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v $id$i $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v $id$i $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -$v -i$i $sshloginid\@$host",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} elsif ($proxy) {
my $v='v';
print "\nSSH PROXY CONNECT: ",
"ssh -$v -i$i ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH PROXY CONNECT: ",
"ssh -$v -i$i ".
"$sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$cmd_handle=$proxy->{_cmd_handle};
$cmd_handle->print("ssh -$v -i$i ".
" $sshloginid\@$host");
$cmd_pid=$proxy->{_cmd_pid};
} else {
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -v -i$i $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -v -i$i $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh",'-v',"-i$i",
"$sshloginid\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");
}
} else {
if (-1<index $stderr,'/dev/tty: No') {
my $v='v';
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('bash').
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh -$v $sshloginid\@$host",
'',$Net::FullAuto::FA_Core::slave])
or (&release_fa_lock(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} elsif ($proxy) {
my $v='v';
print "\nSSH PROXY CONNECT: ",
"ssh -$v $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH PROXY CONNECT: ",
"ssh -$v $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$cmd_handle=$proxy->{_cmd_handle};
$cmd_handle->print("ssh -$v $sshloginid\@$host");
$cmd_pid=$proxy->{_cmd_pid};
} else {
my $v='v';
print "\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSSH CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('bash'),
'bash','-ic',
$Net::FullAuto::FA_Core::gbp->('ssh'),
"ssh -$v $sshloginid\@$host",
" at Line: ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
[$Net::FullAuto::FA_Core::gbp->('ssh').
"ssh","-$v","$sshloginid\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");
}
}
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cdtimeout);
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
}
$cmd_handle->telnetmode(0);
$cmd_handle->binmode(1);
$cmd_handle->output_record_separator("\r");
$cmd_handle->timeout($cdtimeout);
};
if ($@) {
if ($rm_cnt==$#connect_method) {
undef $@;next;
} else {
my $die=$@;undef $@;
die $die;
}
}
unless ($password) {
unless (exists $Hosts{$hostlabel}{'IdentityFile'}
&& $Hosts{$hostlabel}{'IdentityFile'}) {
if ($cmd_errmsg &&
(-1==index $cmd_errmsg,'Cannot su to') ||
(-1==index $cmd_errmsg,'password:')) {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'',$cmd_errmsg)
} else {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','')
}
}
} else {
$login_passwd=$password;
}
$cmd_type='ssh';
## Wait for password prompt.
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect },0,'_notnew_','','',
$hostlabel,$login_passwd);
if ($stderr) {
if (-1<index $stderr,'/dev/tty: No') {
next WH;
} elsif ($main::aws) {
sleep 10;
$stderr='/dev/tty: No';
if ($retrys++==10) {
die 'Connection refused';
} else {
print "\n Waiting for sshd service on ",
"$hostlabel to start . . .\n";
}
next WH;
} elsif ((-1<index $stderr,'Permanently added') &&
(-1<index $stderr,'Roaming not allowed') &&
(-1<index $stderr,'Connection closed')) {
$stderr='/dev/tty: No';
next WH;
} elsif ($stderr=~/password:\s+$/s) {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','');
$stderr='';
} elsif ($rm_cnt!=$#connect_method) {
$cmd_handle->close;
next CM3;
}
}
} last
}
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error($@)
} last
}
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
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 ($hostl) via ",
"$cmd_type . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostl) via ".
"$cmd_type . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (10) into $host ($hostl) via ",
"$cmd_type . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging (10) into $host ($hostl) via ".
"$cmd_type . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (10) into $host ($hostl) via ",
"$cmd_type . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $cfh_ignore='';my $cfh_error='';
unless ($cmd_type eq 'shell') {
## Send password.
$cmd_handle->print($login_passwd);
$cmd_handle=&Rem_Command::wait_for_prompt(
$cmd_handle,$timeout,\@connect_method,$hostlabel,'',$looped);
# Find out what the shell is.
($shell,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
'set | '.
$Net::FullAuto::FA_Core::gbp->('grep',$cmd_handle,$hostlabel).
'grep SHELL=');
$shell=~s/SHELL=//;
$shell=~s/^['"]//;
$shell=~s/['"]$//;
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
} else { $shell='bash' }
my $ctt=2;
while ($ctt--) {
($uname,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'uname');
if (!$uname && !$stderr) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
} last if $uname;
}
die 'no-uname' if !$uname || $stderr;
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::cmd_login() UNAME: ==>$uname<==",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\nRem_Command::cmd_login() UNAME: ==>$uname<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug;
if (lc($uname)=~/cygwin/) {
$uname='cygwin';$cygwin=1;
} elsif ($uname eq 'AIX') {
$uname='aix';
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=$uname;
($shell_pid,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'echo $$');
$shell_pid||=0;
$shell_pid=~/^(\d+)$/;
$shell_pid=$1;
if (!$shell_pid) {
$cmd_handle->print;my $ct=0;
$cmd_handle->print(' '.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;echo $$;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');
my $allins='';$ct=0;
while (1) {
eval {
while (my $line=$cmd_handle->get(
Timeout=>5)) {
$line=~tr/\0-\37\177-\377//d;
chomp($line);
$allins.=$line;
print $Net::FullAuto::FA_Core::LOG
"SHELLPIDLINEEEERRRRRRRR=$allins<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($allins=~/!!(.*)%%/) {
$shell_pid=$1;
print $Net::FullAuto::FA_Core::LOG
"SHELLPIDRRRRR**AAAAA=$shell_pid<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last;
}
}
};
if ($@) {
$cmd_handle->print;
} elsif (!$shell_pid && $ct++<50) {
$cmd_handle->print;
} else {
print $Net::FullAuto::FA_Core::LOG
"SHELL_PIDRRRRR**BBBB=$shell_pid<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
last
}
}
}
$shell_pid=~tr/\0-\11\13-\37\177-\377//d;
chomp($shell_pid);
print $Net::FullAuto::FA_Core::LOG
"SHELLPID_CMD_LOGIN=$shell_pid<=**=**=**=**=**=**=**=**=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($su_id) {
${$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{'cmd_su_'.$Net::FullAuto::FA_Core::pcnt}}[2]=$shell_pid;
} else {
${$Net::FullAuto::FA_Core::Processes{$hostlabel}{$login_id}
{'cmd_id_'.$Net::FullAuto::FA_Core::pcnt}}[2]=$shell_pid;
}
if (!$cygwin) {
if ($su_id) {
$su_login=1;
my ($ignore,$su_err)=
&Net::FullAuto::FA_Core::su($cmd_handle,$hostlabel,$su_id,
$su_id,$hostname,$ip,$use,$uname,$_connect,$cmd_type,
[],$stderr);
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;
}
} else {
&Net::FullAuto::FA_Core::acquire_fa_lock(8712);
($cygdrive,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
$Net::FullAuto::FA_Core::gbp->('mount')."mount -p");
&Net::FullAuto::FA_Core::release_fa_lock(8712);
$cygdrive=~s/^.*(\/\S+).*$/$1/s;
}
}
if (!$uname) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
($uname,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'uname');
$cmd_handle->print;
if (!$uname) {
$cmd_handle->print(' '.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;uname;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');
my $allins='';my $ct=0;
while (my $line=$cmd_handle->get) {
$line=~tr/\0-\37\177-\377//d;
chomp($line);
$allins.=$line;
if ($allins=~/!!(.*)%%/) {
$uname=$1;
last;
} else {
$cmd_handle->print;
} last if $ct++==10;
}
}
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
if (lc($uname)=~/cygwin/) {
$uname='cygwin';$cygwin=1;
} elsif ($uname eq 'AIX') {
$uname='aix';
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=$uname;
($homedir,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'pwd');
$cmd_handle->print;
if (!$homedir) {
$cmd_handle->print(' '.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\041\\\\041;uname;'.
$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\045\\\\045');
my $allins='';my $ct=0;
while (my $line=$cmd_handle->get) {
$line=~tr/\0-\37\177-\377//d;
chomp($line);
$allins.=$line;
if ($allins=~/!!(.*)%%/) {
$uname=$1;
last;
} else {
$cmd_handle->print;
} last if $ct++==10;
}
}
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
}
print $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,{ _cmd_handle=>$cmd_handle,
_uname=>$uname },$cmd_type,$cygdrive,
$_connect);
my $curdir='';
if ($uname eq 'cygwin') {
($curdir,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ]
},'pwd');
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;
my $cdr='';
if (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ]
},"cygpath -w \"$curdir\"");
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
}
${$work_dirs}{_pre_mswin}=
${$work_dirs}{_cwd_mswin}=$cdr.'\\\\';
${$work_dirs}{_pre}=${$work_dirs}{_cwd}=$curdir.'/';
} else {
($curdir,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'pwd');
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;
$curdir.='/' if $curdir ne '/';
${$work_dirs}{_pre}=${$work_dirs}{_cwd}=$curdir.'/';
print $Net::FullAuto::FA_Core::LOG
"CURDIRDETERMINED!!!!!!=$curdir<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
};
if ($@) {
$cmd_errmsg=$@;
#print "WHAT IS THE CMD_ERR=$@\n";<STDIN>;
print $Net::FullAuto::FA_Core::LOG
"\ncmd_login() Login ERROR!".
" - The Username or Password is INCORRECT\n",
" $cmd_errmsg -> Login Name Used: $sshloginid\n",
" at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\ncmd_login() Login ERROR!".
" - The Username or Password is INCORRECT\n",
" $cmd_errmsg -> Login Name Used: $sshloginid\n",
" at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if ((-1<index $cmd_errmsg,'timed-out') ||
(-1<index $cmd_errmsg,'filehandle isn') ||
(-1<index $cmd_errmsg,'no-uname')) {
#print "WHAT IS THE ERROR=$cmd_errmsg<===\n";
print $Net::FullAuto::FA_Core::LOG "WHAT IS THE ERROR=$cmd_errmsg<=== and RETRYS=$retrys\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
#&Net::FullAuto::FA_Core::handle_error("$@ and LINE=$outpt",'__cleanup__') if $outpt;
print "GOING TO RETRY\n";
if ($retrys<10 || (!(defined $main::aws) && $retrys<2)) {
print "EXCELLENT and RETRYS=$retrys\n";
if ($main::aws) {
$cmd_errmsg='/dev/tty: No';
if (5<$retrys) {
$Net::FullAuto::FA_Core::debug=1;
}
print "\n Waiting for a response from ",
"$hostlabel . . .\n";
}
$retrys++;
if (($su_login || $use_su_login) &&
exists $Net::FullAuto::FA_Core::Processes{$hostlabel}
{$su_id}{"cmd_su_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"}
} elsif (exists $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}
}
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if
$shell_pid && &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;next;
} else {
my $host= $hostname ? $hostname : $ip;
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName} if $hostlabel=~/^__Mast/;
$cmd_errmsg="$@\n\n While Attempting "
. "Login to $host\n -> HostLabel "
. "\'$hostl\'\n\n";
if (-1<index $cmd_errmsg,'timed-out') {
$cmd_errmsg.=" \'$hostl\'\n\n Current Timeout "
."Setting is -> $cdtimeout seconds.";
} &Net::FullAuto::FA_Core::handle_error($cmd_errmsg);
}
} my $die_login_id='';
if (($su_login || $use_su_login) &&
exists $Net::FullAuto::FA_Core::Processes{$hostlabel}
{$su_id}{"cmd_su_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if $shell_pid
&& &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;
} elsif (exists $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"};
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if $shell_pid
&& &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;
}
if (!$Net::FullAuto::FA_Core::cron) {
if ($su_login || $use_su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id,'');
$die_login_id=$su_id;
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id,'');
$die_login_id=$login_id;
}
}
my $unam='';
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (-1<index $cmd_errmsg,'Cannot su to') {
@connect_method=@{$cmd_cnct};
if (2<=$retrys) {
$unam=$uname;
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$su_id);
} else { $retrys++;next }
} else { $retrys++;next }
} elsif ($cmd_errmsg=~/invalid log|ogin incor|sion den/s
&& $cmd_errmsg!~/No more auth/s) {
if ($ms_domain && 2<=$retrys) {
$cmd_errmsg.="\n WARNING! - You may be in"
." Danger of locking out MS Domain\n"
." ID - $login_id!\n\n";
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} elsif (2<=$retrys) {
$unam=$uname;
$unam='MS Windows' if $unam eq 'cygwin';
$cmd_errmsg.="\n WARNING! - You may be in"
." Danger of locking out $unam\n"
." $hostl ID - "
."$login_id!\n\n";
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} else { $retrys++;next }
}
my $c_t=$cmd_type;$c_t=~s/^(.)/uc($1)/e;
if (-1<index $cmd_errmsg,'Could not resolve hostname') {
($die=$cmd_errmsg)=~s/: hostname/:\n\n hostname/s;
} else {
#print "IS THIS REALLY WHERE WE ARE DYINGMMMMMMMMMM and CMDERR=$cmd_errmsg<==\n";<STDIN>;
$die="The System $hostname Returned\n the "
."Following Unrecoverable Error Condition\,\n"
." Rejecting the $c_t Login Attempt "
."of the ID\n -> $die_login_id "
."at ".(caller(2))[1]." line ".(caller(2))[2]
." :\n\n $cmd_errmsg";
}
$die.="\n While Attempting "
. "Login to $host\n -> HostLabel "
. "\'$hostl\'\n\n";
$Net::FullAuto::FA_Core::fa_login.=$die;
if ($ms_domain
&& $cmd_errmsg=~/invalid log|ogin incor|ogon fail/) {
$die.="\nHint: Your MS Domain -> $ms_domain Login ID may be "
."locked out.\n Contact Your System "
."Administrator for Assistance.\n\n";
}
$cmd_handle=Bad_Handle->new($hostlabel,$die);
last;
} else { last }
last if $die;
}
print $Net::FullAuto::FA_Core::LOG
"GETTTING OUT OF HERE!!!!!==>cmd_login()\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
return $cmd_handle,$work_dirs,$homedir,$uname,$cmd_type,$ftm_type,
$die,$ip,$hostname,$cmd_pid,$shell_pid,$cygdrive,$shell;
} ## END of &cmd_login()
sub clean_filehandle
{
return &Net::FullAuto::FA_Core::clean_filehandle(@_);
}
sub wait_for_prompt {
my $cmd_handle=$_[0];
my $timeout=$_[1];
my @connect_method=@{$_[2]};
my $hostlabel=$_[3];
my $from_su=$_[4]||'';
my $looped=$_[5]||0;
$Net::FullAuto::FA_Core::uhray=&Net::FullAuto::FA_Core::get_prompt();
unless ($from_su) {
$cmd_handle->print(' cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
}
my $previous_method='';my $sshloginid='';my $ignore='';
my $preferred=0;my $outpt='';my $cygdrive='';my $prompt='';
my $output='';my $ct=0;my $tymeout=1;
while (1) {
if (($ct==1) && (5<$timeout)) {
$tymeout=5;
} elsif (($ct==2) && (10<$timeout)) {
$tymeout=10;
} elsif (2<$ct) {
$tymeout=$timeout;
}
eval {
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
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;
local $SIG{ALRM} = sub { die "read timed-out\n" }; # \n required
while (my $line=$cmd_handle->get(Timeout=>$tymeout)) {
alarm $timeout+1;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
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;
$line=~tr/\0-\11\13-\37\177-\377//d;
chomp($line);
$outpt.=$line;
$output.=$line;
$output=~s/login:.*//s;
if ($line=~/(?<!Last )login[: ]*$/m ||
unpack('a10',$line) eq 'Login inco'
|| (-1<index $line,'Perm')) {
while (1) {
if (-1<$#connect_method) {
last if $previous_method eq $connect_method[0];
shift @connect_method;
} else { last }
}
$output=~s/^\s*//s;
$output=~s/\s*//s;
if ($output=~/^.*(Perm.*)$/s) {
my $one=$1;
if ($output=~/^.*(No more auth.*)$/s) {
die "$1\n";
}print "GOING HERE\n";die "$one\n";
}
die "$output\n";
} elsif ($output=~
/Connection (?:to localhost closed|closed|reset)/s) {
die "$output\n";
} elsif (-1<index $line,'/bin/bash: Operation not permitted') {
Net::FullAuto::FA_Core::bash_operation_not_permitted(
$hostlabel,$looped);
}
if ($outpt=~
/${$Net::FullAuto::FA_Core::uhray}[0]_-(.*)$/s) {
$prompt=$1;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
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;
last;
} elsif ($outpt=~/^((?:bash)*[\$%#>])\s*cmd \//m) {
$prompt=$1;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
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;
last;
}
}
};alarm(0);
if ($@) {
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::cmd_login() (eval) ERROR in \"wait_for_prompt()\":\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::LOG,'*';
print "\nRem_Command::cmd_login() (eval) ERROR in \"wait_for_prompt()\":\n ",
"==>$@<==\n SEPARATOR=",
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug;
my $ev_err=$@;
if ($ev_err=~/read timed-out/s && $ct++<3) {
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();
$cmd_handle->print(' cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
} elsif ($sshloginid &&
$ev_err=~/Permission denied/s) {
if ($ev_err=~/No more auth/s) {
die $ev_err;
} else {
print "WE GET HEREEEEEEEEEE\n";
$cmd_handle->print(&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$sshloginid,'',$@,
'__force__'));
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();
$cmd_handle->print(' cmd /Q /C "set /A '
.${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::gbp->('printf').
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2]
.'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
}
} else { die $ev_err }
} else { last }
}
$cmd_handle->prompt('/_funkyPrompt_$/');
$cmd_handle->print(
" export PS1=_funkyPrompt_;unset PROMPT_COMMAND");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
return $cmd_handle;
} ## END OF &wait_for_prompt
sub ftpcmd
{
my @topcaller=caller;
print "\nINFO: Rem_Command::ftpcmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::ftpcmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $handle=$_[0];my $cache='';
#print "DUMP=",Data::Dump::Streamer::Dump($handle)->Out()," and CALLER=",caller,"\n";<STDIN>;
my $cmd=$_[1];my $ftperr='';my $return_all=0;my $display=0;
if (1<$#_) {
foreach my $i (2..$#_) {
if ($_[$i] eq '__return_all_output__') {
$return_all=1;
} elsif (-1<index $_[$i],'Cache::FileCache') {
$cache=$_[$i];
} elsif ((-1<index $_[$i],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[$i]->chi_root_class)) {
$cache=$_[$i];
} elsif (-1<index $_[$i],'__display__') {
$display=1;
}
}
}
my $hostlabel=$handle->{_hostlabel}->[1]
|| $handle->{_hostlabel}->[0];
my $ftm_type=$handle->{_ftp_type};
my $output='';my $nfound='';my $allbytes='';
my $ready='';my $more='';my $retrys=0;
my $stdout='';my $stderr='';my $hashcount=0;
my $keepcount=0;my $gpfile='';my $seen=0;
$gpfile=unpack('a3',$cmd) if 2<length $cmd;
my $prcnt=0;my $firstvisit=0;my $gf='';
if ($ftm_type eq 'ftp' && ($gpfile eq 'get' || $gpfile eq 'put')) {
my $ex=($gpfile eq 'put')?'!':'';
($gpfile=$cmd)=~s/^...\s+(.*)$/$1/;
chomp $gpfile;my $lsline='';
($gf=$gpfile)=~s/^["']([^"']*)["'].*$/$1/;
if ($gf eq $gpfile && (-1<index $gpfile,' ')) {
$gf=substr($gf,0,(index $gf,' '));
}
$gf=~s/\+/\\\+/g;
my $gfp='';
#if ($ftm_type eq 'sftp') {
# $gfp=' '.substr($gf,0,(rindex $gf,'/'));
# $gfp='' if (-1==index $gfp,'/');
#}
($output,$stderr)=&ftpcmd($handle,"${ex}ls -1$gfp",$cache);
print "\nINFO: Rem_Command::ftpcmd() (S)FTP OUTPUT ",
"FROM (!)ls cmd:\n OUTPUT=$output<== ",
"and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
if ($stderr) {
if (wantarray) {
return $output,$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-13','__cleanup__');
}
} my $gpf=substr($gf,(rindex $gf,'/')+1);
foreach my $line (split /^/, $output) {
if (-1<index $line,'total 0') {
if (wantarray) {
return '',"$cmd: No Files Found";
} else {
&Net::FullAuto::FA_Core::handle_error("$cmd: No Files Found");
}
}
next if unpack('a1',$line) ne '-';
$line=~s/[ ]*\015//g;
$line=~tr/\0-\37\177-\377//d;
if ($line=~s/$gpf$//) {
$lsline=$line;last;
}
}
if (!$lsline) {
($output,$stderr)=&ftpcmd($handle,"${ex}ls -l$gfp",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
foreach my $line (split /^/, $output) {
if (-1<index $line,'total 0') {
if (wantarray) {
return '',"$cmd: No Files Found";
} else {
&Net::FullAuto::FA_Core::handle_error("$cmd: No Files Found");
}
}
next if unpack('a1',$line) ne '-';
$line=~s/[ ]*\015//g;
$line=~tr/\0-\37\177-\377//d;
if ($handle->{_luname} eq 'cygwin') {
if ($gf eq '*') {
if ($line=~/[*]$/i) {
$lsline=$line;last;
}
} elsif ($line=~/$gf$/i) {
$lsline=$line;last;
}
} else {
if ($gf eq '*') {
if ($line=~/[*]$/) {
$lsline=$line;last;
}
} elsif ($line=~/$gf$/) {
$lsline=$line;last;
}
}
}
}
my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;
$lsline=~s/^.*\s+($rx1|$rx2)$/$1/;
($allbytes)=$lsline=~/^(\d+)\s+[JFMASOND]\w\w\s+\d+\s+\S+\s+.*$/;
if ($ftm_type ne 'sftp') {
($output,$stderr)=&ftpcmd($handle,'hash',$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
} elsif ($gpfile eq 'lcd') {
my $llcd=$cmd;
$llcd=~s/^lcd\s+//;
$handle->{_work_dirs}->{_lcd}=$llcd;
} else { $gpfile='' }
print $Net::FullAuto::FA_Core::LOG "\nGOING TO RUN FTP CMD: $cmd\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
eval {
$handle->{_ftp_handle}->print($cmd);
};
if ($@) {
&Net::FullAuto::FA_Core::handle_error(
"$@\n and COMMAND=$cmd and GPFILE=$gpfile".
"and FTP_HANDLE=$handle->{_ftp_handle}\n",'-4');
}
&Net::FullAuto::FA_Core::handle_error($handle->{_ftp_handle}->errmsg)
if $handle->{_ftp_handle}->errmsg;
my $cmdflag=0;my $tcmd='';my $loop=0;
while (1) {
my $starttime=time();
eval {
while (1) {
if (!$more) {
$nfound = select
$ready=${${*{$handle->{_ftp_handle}}}{net_telnet}}{fdmask},
'', '', $handle->{_ftp_handle}->timeout;
} $output='';
if ($nfound > 0 || $more) {
sysread $handle->{_ftp_handle},
$output,
${${*{$handle->{_ftp_handle}}}{net_telnet}}{blksize},
0;
$more='' if $more;
} elsif (!$stdout) {
$starttime=time();
}
print $Net::FullAuto::FA_Core::LOG
"(S)FTP-OUTPUT: ==>$output<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#print "XXXXXXXOUT=$output\n";
$output=~s/[ ]*\015//g;
$output=~tr/\0-\11\13-\37\177-\377//d;
$stdout.=$output."\n";
if ($gpfile && (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug)) {
$hashcount=$output;
$hashcount=($hashcount=~tr/#//);
if ($allbytes && (1<$hashcount) && ($ftm_type ne 'sftp')) {
if (!$firstvisit) {
print $Net::FullAuto::FA_Core::LOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";
}
$firstvisit=1;
}
$hashcount=$hashcount*1024;
$keepcount=$keepcount+$hashcount;
$keepcount=$allbytes if $allbytes<$keepcount;
my $plin="$keepcount bytes, ";
$prcnt=$keepcount/$allbytes;
if (unpack('a1',$prcnt) eq '1') {
$prcnt=100;
} else { $prcnt=substr($prcnt,2,2) }
substr($prcnt,0,1)='' if unpack('a1',$prcnt) eq '0';
$plin.="${prcnt}% of $gpfile transferred . . . ";
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
STDOUT->autoflush(1);
printf("\r% 0s",$plin);
STDOUT->autoflush(0);
}
print $Net::FullAuto::FA_Core::LOG
"FTP STDOUT: ==>$plin<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
sleep 1;
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n" if $keepcount==$allbytes;
}
} elsif (!$keepcount) {
foreach my $line (split /\n+/, $output) {
$line=~s/[ ]*\015//g;
$line=~tr/\0-\11\13-\37\177-\377//d;
$line=~tr/#//d;
$line=~s/s*ftp> ?$//s if !($line=~s/^\s*$//m);
print $Net::FullAuto::FA_Core::LOG
uc($ftm_type)." STDOUT: ==>$line<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $upcnt=$line=~/Upload/gs;
$upcnt||=0;
if ($upcnt) {
if ($seen) { next }
$seen=1
}
$line=~s/Upload.*$//s if 1<$upcnt;
my $ftcnt=$line=~/Fetch/gs;
$ftcnt||=0;
if ($ftcnt) {
if ($seen) { next }
$seen=1
}
$line=~s/Fetch.*$//s if 1<$ftcnt;
if ((-1==index $line,'421 Service not')
|| (-1==index $line,'421 Timeout')
|| (-1==index $line,'Not connected')
|| (-1==index $line,'file access p')
|| (-1==index $line,'421 User limit')
|| (-1==index $line,'421 You are not')
|| (-1==index $line,'421 Max con')
|| (-1==index $line,'426 Connection')
|| (-1==index $line,'not found')
|| (-1==index $line,"Couldn't")) {
my $tl=$line;
$tl=~s/[\r|\n]*//sg;
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."\n\n";
STDOUT->autoflush(0);
}
} 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,"\n\n";
STDOUT->autoflush(0);
}
} 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);
printf("\r% 0s",$line);
STDOUT->autoflush(0);
}
} elsif (!$cmdflag &&
$stdout=~/^((?:get|put) ["][^"]+["]).*/s) {
my $printthis=$1;
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print $printthis;
}
$cmdflag=1;
} elsif ($cmd!~/$tl/) {
$cmdflag=1;
} else {
$tcmd=$line;
$cmdflag=1 if $cmd eq $tcmd;
}
}
if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) {
if (5<length $line) {
if (unpack('a6',$line) eq '150 Op') {
print $Net::FullAuto::FA_Core::LOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\n" if !$Net::FullAuto::FA_Core::quiet;
last;
} elsif (unpack('a6',$line) eq '125 St') {
print $Net::FullAuto::FA_Core::LOG "\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\n\n" if !$Net::FullAuto::FA_Core::quiet;
} elsif (unpack('a4',$line) eq '"get') {
print $Net::FullAuto::FA_Core::LOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\n" if !$Net::FullAuto::FA_Core::quiet;
} elsif (unpack('a4',$line) eq '"put') {
print $Net::FullAuto::FA_Core::LOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\n" if !$Net::FullAuto::FA_Core::quiet;
}
}
}
if ($allbytes && $line=~/(\d+) bytes/) {
my $bytestransferred=$1;
my $warn="WARNING! - The transfer of file $gf\n"
." size $allbytes bytes\, "
."aborted at $bytestransferred "
."\n bytes transferred.";
&Net::FullAuto::FA_Core::handle_error(
$warn,'__return__','__warn__')
if $allbytes ne $bytestransferred;
}
}
}
}
if ($output || $stdout=~/s*ftp> ?$/s) {
if ((-1<index $stdout,'bash: ') ||
(-1<index $stdout,'age too lo')) {
print $Net::FullAuto::FA_Core::LOG
"TOO MANY LOOPS - GOING TO RETRY11<=======\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$handle->{_ftp_handle}->print("\004");
die "421 Timeout - $ftm_type read timed out";
}
$loop=0;
$output=~s/[ ]*\015//g;
$output=~tr/\0-\11\13-\37\177-\377//d;
$output=~tr/ //s;
print $output if $display;
if ($output=~/s*ftp> ?$/s || $stdout=~/s*ftp> ?$/s || $more) {
$nfound=select
$ready=${${*{$handle->{_ftp_handle}}}{net_telnet}}{fdmask},
'', '', 0;
if ($nfound) {
$more=1;next;
} else {
$stdout=~s/^(.*?)(\012|\013)+//s;
my $last=0;
if ($stdout=~s/\s*(?:s?ftp>\s*)*$//s) {
$last=1;
}
$stdout=~tr/#//d;
last if $last;
next;
}
} elsif ($stdout=~s/^(.*)Couldn[']t wait for child.*$/$1/s) {
$output=~s/^(.*)Couldn[']twaitforchild.*$/$1/s;
my $hand=Net::FullAuto::connect_sftp($hostlabel,'__quiet__');
$handle->{_ftp_handle}=$hand->{_ftp_handle};
$handle->lcd($handle->{_work_dirs}->{_lcd});
last
}
$starttime=time();
} elsif ((!$gpfile && $loop++==10) || (-1<index $stdout,'bash: ')) {
print $Net::FullAuto::FA_Core::LOG "TOO MANY LOOPS - GOING TO RETRY<22=======\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$handle->{_ftp_handle}->print("\004");
$stdout="421 Timeout - $ftm_type read timed out";die
} elsif ($handle->{_ftp_handle}->timeout<time()-$starttime) {
print $Net::FullAuto::FA_Core::LOG "$ftm_type read timed out<=======\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "$ftm_type read timed out1 and OUTPUT=$output<=======\n";
if ($retrys<2) {
$retrys++;
$handle->{_ftp_handle}->print("\004");
$stdout="421 Timeout - $ftm_type read timed out at Line ".
__LINE__;die
} else {
my $tmot="421 Timeout - $ftm_type read timed out\n"
." Timeout=".$handle->{_ftp_handle}->timeout
."\n at Line: ".__LINE__;
&Net::FullAuto::FA_Core::handle_error($tmot,'__cleanup__');
}
}
} print "\n" if $output && $gpfile
&& $keepcount && !($Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::quiet) || $Net::FullAuto::FA_Core::debug;
};
print $Net::FullAuto::FA_Core::LOG "FTP-STDOUT-COMPLETED=$stdout<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($stdout=~/^5\d+\s+$/m && $stdout!~/^5\d+\s+bytes.*$/m) {
$stdout=~/^(5.*)$/m;
$stderr=$1;
$stderr=~s/[ ]*\015//g;
$stderr=~tr/\0-\37\177-\377//d;
print $Net::FullAuto::FA_Core::LOG "FTP-STDERR-500-DETECTED=$stderr<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
} elsif ((-1<index $stdout,":5") && $stdout=~/^(.*:5\d\d\s.*)$/m) {
my $line=$1;
$line=~s/[ ]*\015//g;
$line=~tr/\0-\37\177-\377//d;
$stderr="$line\n $!" if $line!~/^\d+\s+bytes/;
} elsif ((-1<index $stdout,'file access p')
|| (-1<index $stdout,'not found')
|| (-1<index $stdout,"Couldn't")) {
print $Net::FullAuto::FA_Core::LOG
"$ftm_type File ERROR: ==>$stdout<==\n\n".
" and HOSTLABEL=$hostlabel\n\n"
if -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$stdout;
} else {
return $stdout;
}
} 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::LOG
"$ftm_type 400 SERIES ERROR: ==>$stdout<==\n\n".
" and HOSTLABEL=$hostlabel\n\n"
if -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\n\n$ftm_type 400 SERIES ERROR:\n\n".
" ==>$stdout<==\n\n".
"Attempting to reconnect and retry . . .\n\n"
if !$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet;
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fctimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,
$handle->{_connect});
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fctimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fctimeout) {
$fctimeout=$timeout if !$fctimeout;
}
my $ftm_errmsg='';
my $host=($use eq 'ip') ? $ip : $hostname;
$handle->{_ftp_handle}->print('bye');
my $sav_ftp_handle='';my $ftp_handle='';
while (my $line=$handle->{_ftp_handle}->get) {
last if $line=~/_funkyPrompt_$/s;
if ($line=~/logout/s) {
$sav_ftp_handle=$handle->{_ftp_handle};
$handle->{_ftp_handle}->close;
($ftp_handle,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',$handle->{_connect});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$handle->{_ftp_handle}=$ftp_handle->{_cmd_handle};
foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($sav_ftp_handle eq
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
delete $Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
} elsif ($handle->{_ftp_handle} eq
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
substr($type,0,3)='ftp';
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}=
$handle->{_ftp_handle};
}
}
}
}
}
}
if ( -1<index $stdout,'file access p') {
($handle->{_ftp_handle},$stderr)=
&login_retry($ftp_handle->{_cmd_handle},
$ftp_handle->{_connect},
$ftp_handle->{_cmd_type},$stdout);
if ($stderr) {
$stderr="$stdout\n $stderr";
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
} elsif (!$handle->{_ftp_handle}) {
if (wantarray) {
return '',$stdout;
} else {
&Net::FullAuto::FA_Core::handle_error($stdout);
}
}
} my $ftm_passwd='';
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,
$ms_share,$ftm_errmsg,'__su__');
#if ($ftm_passwd ne 'DoNotSU!') {
# $su_login=1;
#} else { $su_id='' }
$su_id=''
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg);
}
my $fm_cnt=-1;
foreach my $connect_method (@{$ftr_cnct}) {
$fm_cnt++;my $gotname=0;
if (lc($connect_method) eq 'ftp') {
my $go_next=0;
eval {
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
$handle->{_ftp_handle}->print(
" ${Net::FullAuto::FA_Core::ftppath}ftp $host");
## Look for Name Prompt.
while (my $line=$handle->{_ftp_handle}->get) {
my $tline=$line;
$tline=~s/Name.*$//s;
if (-1<index $tline,'ftp: connect:') {
$tline=~/^.*connect:\s*(.*?\n).*$/s;
if ((-1==index $tline,'Address already in use')
&& (-1==index $tline,'Connection timed out')) {
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
&Net::FullAuto::FA_Core::handle_error(
"ftp: connect: $1");
}
} else {
$handle->{_ftp_handle}->close
if defined fileno $handle->{_ftp_handle};
sleep int $handle->{_ftp_handle}->timeout/3;
($handle->{_ftp_handle},$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',
$handle->{_connect});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$handle->{_ftp_handle}=$ftp_handle->{_cmd_handle};
$handle->{_ftp_handle}->print(' '.
"${Net::FullAuto::FA_Core::ftppath}ftp $host");
FH1: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($handle->{_ftp_handle}
eq $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
substr($type,0,3)='ftp';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}
{$type}=$handle->{_ftp_handle};
last FH1;
}
}
}
}
$tline=$line;
$tline=~s/Name.*$//s;
}
} elsif (-1<index $tline,'421 Service' ||
-1<index $tline,'No address associated with name'
|| (-1<index $tline,'Connection' &&
(-1<index $tline,'Connection closed' ||
-1<index $tline,
'ftp: connect: Connection timed out'))) {
$tline=~s/s*ftp> ?$//s;
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
&Net::FullAuto::FA_Core::handle_error($tline);
}
}
print "TLIN=$tline"
if !$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "TLIN=$tline"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (-1<index $tline,
'ftp: connect: Connection timed out') {
$tline=~s/s*ftp> ?\s*$//s;
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
&Net::FullAuto::FA_Core::handle_error($tline);
}
} elsif ((-1<index $line,'A remote host refused')
|| (-1<index $line,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;
$line=~s/^(.*)?\n.*/$1/s;
my $die=$line;
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
$die.="Destination Host - $host, HostLabel "
."- $hostlabel\n refused an "
."attempted connect operation.\n "
."Check for a running FTP daemon on "
.$hostlabel;
&Net::FullAuto::FA_Core::handle_error($die);
}
}
if ($line=~/Name.*[: ]+$/si) {
$gotname=1;last;
}
}
};
if ($@) {
if ($@=~/read timed-out/) {
my $die="&ftm_login() timed-out while\n "
."waiting for a login prompt from\n "
."Remote Host - $host,\n HostLabel "
."- $hostlabel\n\n The Current Timeout"
." Setting is ".$handle->{_ftp_handle}->timeout
." Seconds.";
&Net::FullAuto::FA_Core::handle_error($die);
} elsif ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;
} else {
&Net::FullAuto::FA_Core::handle_error($@);
}
} next if $go_next || !$gotname;
if ($su_id) {
$handle->{_ftp_handle}->print($su_id);
} else {
$handle->{_ftp_handle}->print($login_id);
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$handle->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$ftm_type,
_connect=>$handle->{_connect} });
$ftm_type='ftp';
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$handle->{_ftp_handle}->print('bye');
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$handle->{_ftp_handle});
next;
}
} last
} elsif (lc($connect_method) eq 'sftp') {
my $sftploginid=($su_id)?$su_id:$login_id;
my $sshport='';
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';
}
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}
{'IdentityFile'}) {
$Net::FullAuto::FA_Core::gbp->('sftp');
my $id=$Net::FullAuto::FA_Core::sftpifil;
$sshport.=$id.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}
{'IdentityFile'}.' ';
}
print "\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$sftploginid\@$host at Line: ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSFTP CONNECT: ",
$Net::FullAuto::FA_Core::gbp->('sftp'),'sftp ',
"${sshport}$sftploginid\@$host at Line: ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$handle->{_ftp_handle}->print(' '.
$Net::FullAuto::FA_Core::gbp->('sftp').'sftp '.
"${sshport}$sftploginid\@$host");
FH: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($handle->{_ftp_handle} eq
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};
substr($type,0,3)='ftp';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$handle->{_ftp_handle};
last FH;
}
}
}
}
my $hostl=$hostlabel;
$hostl=$Hosts{$hostlabel}{HostName}||$Hosts{$hostlabel}{IP}
if $hostlabel=~/^__Mast/;
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (11)
print "\n Logging into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (11) into $host ($hostl) via ",
"sftp . . .\n\n";
$cache->set($cache->{'key'},[0,
"\n Logging (11) into $host ($hostl) via ".
"sftp . . .\n\n"])
if $cache;
}
print $Net::FullAuto::FA_Core::LOG
"\n Logging (11) into $host ($hostl) via ",
"sftp . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::LOG,'*';
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$handle->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$ftm_type,
_connect=>$handle->{_connect} });
$ftm_type='sftp';
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$handle->{_ftp_handle}->print('bye');
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$handle->{_ftp_handle});
next;
}
} last
}
}
my %ftp=(
_ftp_handle => $handle->{_ftp_handle},
_ftp_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $handle->{_uname},
_hostlabel => [ $hostlabel,$handle->{_hostlabel}->[0] ]
);
$handle->{_ftp_handle}->prompt("/s*ftp> ?\$/");
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
$ftm_passwd,$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary',$cache)
if $ftm_type ne 'sftp';
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
if (exists $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd}",
$cache);
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{cd}=
$Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd};
delete $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd};
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
} elsif (exists
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{cd}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd $Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{cd}",
$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
}
if (0) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'pwd',$cache)
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "FTPCMD--PWD=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
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::LOG,'*';
}
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);
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd}=
$Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd};
delete $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd};
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
} elsif (exists
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'lcd '.
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd},
$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
}
if ($gpfile && $ftm_type ne 'sftp') {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'hash',$cache);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
}
$stdout='';$stderr='';
$handle->{_ftp_handle}->print($cmd);
next
} elsif ($ftm_type eq 'sftp') {
$stdout=~s/^$cmd\s*(.*)\s*sftp>\s*$/$1/s;
$stdout=~tr/\r//d;
$stdout=~s/\s*$//s;
if (exists $handle->{_cmd_handle} && $handle->{_cmd_handle}) {
if ($stdout=~/Couldn\'t canonicalise:/s) {
if ($cmd=~/^ls$|^ls /) {
($output,$stderr)=$handle->cmd($cmd);
if ($stderr) {
$stderr=$stdout;
} else { $stdout=$output }
} elsif ($cmd=~/^cd /) {
($output,$stderr)=$handle->cmd('pwd');
if ($stderr) {
$stderr=$stdout;
} else {
$output=~s/^.*direcotory: (.*)$/$1/;
my $out='';
($out,$stderr)=$handle->cmd($cmd);
if ($stderr) {
$stderr=$stdout;
} else {
chomp $output;
($out,$stderr)=$handle->cmd("cd $output");
if ($stderr) { $stderr=$stdout }
}
}
} else { $stderr=$stdout }
} elsif ((-1<index $stdout,'Permission denied') ||
(-1<index $stdout,'t stat remote file')) {
if ($cmd=~/^ls$|^ls /) {
if (!exists $GLOBAL{'nested_ls'}) {
$GLOBAL{'nested_ls'}=1;
($output,$stderr)=$handle->cmd($cmd);
} else {
delete $GLOBAL{'nested_ls'};
}
if ($stderr) {
$stderr=$stdout;
} elsif (-1<index $stdout,'t stat remote file') {
$stderr=$stdout;
} else { $stdout=$output }
} elsif (unpack('a4',$cmd) eq 'get ') {
if ((-1<index $stdout,'t stat remote file') ||
(-1<index $stdout,'t get handle')) {
my $stder='';
if ($cmd=~/^get\s+\"((?:\/|[A-Za-z]:).*)\"$/) {
my $path=$1;
$path=~/^(.*)[\/|\\]([^\/|\\]+)$/;
my $dir=$1;my $file=$2;my $getfile='';
my $testf=&Net::FullAuto::FA_Core::test_file($handle,
$path);
if ($testf eq 'WRITE' || $testf eq 'READ') {
if (exists $handle->{_work_dirs}->{_tmp}) {
($output,$stder)=$handle->cmd("cp -p $path ".
$handle->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stder)
if $stder;
$getfile=$handle->{_work_dirs}->{_tmp}.
'/'.$file;
print "COPIED and GETFILE=$getfile<==\n";#<STDIN>;
} elsif (exists
$handle->{_work_dirs}->{_tmp_mswin}) {
print "COPIED and GETFILE222=$getfile<==\n";#<STDIN>;
($output,$stder)=$handle->cmd("cp -p $path ".
$handle->{_work_dirs}->{_tmp_mswin});
&Net::FullAuto::FA_Core::handle_error($stder)
if $stder;
$getfile=$handle->{_work_dirs}->{_tmp_mswin}.
'\\'.$file;
}
$getfile=~s/^["']+(.*)["']+$/$1/;
($output,$stderr)=
&Rem_Command::ftpcmd(
$handle,"get \"$getfile\"",$cache);
if (!$stderr) {
($output,$stderr)=$handle->cmd(
"rm -f \"$getfile\"");
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
} $stdout=$output;
}
}
}
} elsif (unpack('a4',$cmd) eq 'put ') {
if (-1<index $stdout,'Uploading') {
if (-1<index $stdout,'t get handle') {
} #elsif (-1<index $stdout,'t open local file') {
#}
}
}
}
}
} elsif ($stdout=~/^4\d+\s+/m && $stdout!~/^4\d+\s+bytes.*$/m) {
my $line='';
foreach my $lin (split /^/, $stdout) {
$line.=" $lin" if unpack('a1',$lin) eq '4';
}
$stdout='';
$stderr=$line;
} elsif ($stdout=~/ftp: \w+: /) {
my $line='';
foreach my $lin (split /^/, $stdout) {
$line.=" $lin";
}
$stdout='';
$stderr=$line;
} else {
my $c='';
($c=$cmd)=~s/\+/\\\+/sg;
$stdout=~s/^$c\s*(.*)\s+s*ftp>\s*$/$1/s;
my $tmpso=$stdout;$stdout='';
}
if (!$stderr && $gpfile) {
($output,$stderr)=&ftpcmd($handle,'hash',$cache)
if $ftm_type ne 'sftp';
if ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
print "\n";
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
print "\nINFO: Rem_Command::ftpcmd() <<<<<<<RETURNING>>>>>>>:\n ",
"STDOUT=$stdout<== and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::ftpcmd() <<<<<<<RETURNING>>>>>>>:\n ",
"STDOUT=$stdout<== and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
if (wantarray) {
return $stdout,$stderr;
} elsif (!$stdout && $stderr) {
return $stderr;
} else { return $stdout }
}
}
sub repl
{
my @topcaller=caller;
print "\nINFO: Rem_Command::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=(defined $Net::FullAuto::FA_Core::newrepl)?
$Net::FullAuto::FA_Core::newrepl:$_[0];
my $command=$_[1];$command||='';my $output='';
while (1) {
$self->{_cmd_handle}->print(' '.$command);
eval {
while (my $line=$self->{_cmd_handle}->get(Timeout=>30)) {
print $Net::FullAuto::FA_Core::LOG
"REPL LINE=>$line<=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#print "REPLLINE=$line\n";
$output.=$line;
last if $output=~s/\n*repl\d*>\s*$//;
last if $output=~/Host context unloading/s;
last if $output=~/Connection closed by/s;
if ($output=~/[.][.][.][.][>]/) {
$self->{_cmd_handle}->print(';');
sleep 2;
next;
}
}
};
if ($@ || $output=~/Connection closed by/s) {
#print "GOING FOR NEW SELF\n";
$self->{_cmd_handle}->print("\004");
my $kill_arg=($^O eq 'cygwin')?'f':9;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$self->{_cmd_pid},$kill_arg);
$self->{_cmd_handle}->close;
# ($output,$stderr)=$Net::FullAuto::FA_Core::localhost->cmd('ps -e');
#print "PS OUT=$output\n";<STDIN>;
$Net::FullAuto::FA_Core::newrepl=
Net::FullAuto::FA_Core::connect_mozrepl();
$self=$Net::FullAuto::FA_Core::newrepl;
$output='';
undef $@;
next;
} else { last }
}
$output=~s/^\s*//s;
substr($output,0,(length $command))='';
$output=~s/^\s*//s;
$output=~tr/\0-\11\13-\37\177-\377//d;
chomp($output);
my $error=$output if $output=~/^[!][!][!]|back to creation context/;
$error=$output if -1<index $output,'!!! SyntaxError:';
$error=$output if $output=~/Connection closed by/s;
my $die='';
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;
}
if (wantarray) {
$output='' if $error;
$error||='';
return $output,$error;
} elsif ($error) {
&Net::FullAuto::FA_Core::handle_error($error);
} else {
return $output;
}
}
sub cmd
{
my @topcaller=caller;
print "\nINFO: Rem_Command::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];my $cache='';
my $kill_arg=($^O eq 'cygwin')?'f':9;
my @args=@_;shift @args;shift @args;
my $command=$_[1];$command||='';my $delay=0;
my $ftp=0;my $live=0;my $display=0;my $log=0;
my $wantarray= wantarray ? wantarray : '';
my $cmtimeout='X';my $svtimeout='X';my $sem='';
my $notrap=0;my $ignore='';my $login_retry=0;
my $allow_no_output=0;
my ($stdout,$stderr)=('','');
if (defined $_[2] && $_[2]) {
if ($_[2]=~/^[0-9]+/) {
$cmtimeout=$_[2];
} else {
my $arg=lc($_[2]);
if ($arg eq '__ftp__') {
$ftp=1;
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1;
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} elsif (-1<index $_[2],'Cache::FileCache') {
$cache=$_[2];
} elsif ((-1<index $_[2],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[2]->chi_root_class)) {
$cache=$_[2];
} elsif ($wantarray) {
return 0,'Third Argument for Timeout Value is not Whole Number';
} else {
&Net::FullAuto::FA_Core::handle_error(
'Third Argument for Timeout Value is not Whole Number')
}
}
} my $login_id='';
if (defined $_[3] && $_[3]) {
my $arg=lc($_[3]);
if ($arg eq '__ftp__') {
$ftp=1;
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} elsif (-1<index $_[3],'Cache::FileCache') {
$cache=$_[3];
} elsif ((-1<index $_[3],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[3]->chi_root_class)) {
$cache=$_[3];
} else {
$login_id=$_[3];
}
}
while (1) {
my $cmd_prompt='';my $cmdprompt='';my $ms_cmd_prompt='';
if (defined $_[4] && $_[4]) {
my $arg=lc($_[4]);
if ($arg eq '__ftp__') {
$ftp=1;
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} elsif (-1<index $_[4],'Cache::FileCache') {
$cache=$_[4];
} elsif ((-1<index $_[4],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[4]->chi_root_class)) {
$cache=$_[4];
} elsif (0) {
my $tmp_cmd_prompt=$cmd_prompt=$_[4];
if (unpack('a2',$cmd_prompt) ne '(?' &&
($cmd_prompt=~/\|\|/s || $cmd_prompt=~/\|[Mm]\|/s)) {
$cmd_prompt=~s/^(.*)(?:\|\||\|[Mm]\|)//s;
$tmp_cmd_prompt=$1;
pos($cmd_prompt)=0;
while ($cmd_prompt=~/(\|\||\|[Mm]\|)(.*)/g) {
if ($1 eq '||') {
$tmp_cmd_prompt.="|$2";
} else {
$ms_cmd_prompt.="|$2";
}
}
}
$cmd_prompt=
qr/$tmp_cmd_prompt/ if unpack('a2',$cmd_prompt) ne '(?';
}
} elsif (!$ftp) {
$cmd_prompt=substr($self->{_cmd_handle}->prompt,1,-2);
}
if (defined $_[5] && $_[5]) {
my $arg=lc($_[5]);
if ($arg eq '__ftp__') {
$ftp=1;$arg='';
} elsif ($arg eq '__allow_no_output__') {
$allow_no_output=1;
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;$arg='';
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} elsif (-1<index $_[5],'Cache::FileCache') {
$cache=$_[5];
} elsif ((-1<index $_[5],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[5]->chi_root_class)) {
$cache=$_[5];
} else {
if (&Net::FullAuto::FA_Core::test_semaphore($_[5])) {
if ($wantarray) {
return 0,"Semaphore Blocking Command";
} else { return 'Semaphore Blocking Command' }
} else {
&Net::FullAuto::FA_Core::acquire_fa_lock($_[5]);
$sem=$_[5];
}
}
}
if (!$ftp && (grep{lc($_) eq '__ftp__'}@_)) {
$ftp=1;
} elsif (!$allow_no_output &&
(grep{lc($_) eq '__allow_no_output__'}@_)) {
$allow_no_output=1;
} elsif (!$live && (grep{lc($_) eq '__live__'}@_)) {
$live=1;
} elsif (!$display && (grep{lc($_) eq '__display__'}@_)) {
$ftp=1;
} elsif (!$log && (grep{lc($_) eq '__log__'}@_)) {
$log=1;
} elsif (!$notrap && (grep{lc($_) eq '__notrap__'}@_)) {
$notrap=1;
} elsif (!$delay && (grep{lc($_) eq '__delay__'}@_)) {
$delay=1;
} elsif ($login_retry==0 && (grep{lc($_) eq '__retry_on_error__'}@_)) {
$login_retry=-1;
} elsif (!$cache &&
(grep{/Cache::FileCache|Moose::Meta::Class::__ANON__::SERIAL/}@_)) {
foreach my $i (0..$#_) {
if (-1<index $_[$i],'Cache::FileCache') {
$cache=$_[$i];
last;
} elsif ((-1<index $_[$i],'Moose::Meta::Class::__ANON__::SERIAL')
&& ($_[$i]->chi_root_class)) {
$cache=$_[$i];
last;
}
}
}
if ($cmtimeout eq 'X') {
if ($ftp) {
$cmtimeout=$self->{_ftp_handle}->timeout;
$svtimeout=$self->{_ftp_handle}->timeout;
} else {
$cmtimeout=$self->{_cmd_handle}->timeout;
$svtimeout=$self->{_cmd_handle}->timeout;
}
} elsif ($ftp) {
$svtimeout=$self->{_ftp_handle}->timeout;
$self->{_ftp_handle}->timeout($cmtimeout);
} else {
$svtimeout=$self->{_cmd_handle}->timeout;
$self->{_cmd_handle}->timeout($cmtimeout);
}
my $caller=(caller(1))[3];
$caller='' unless defined $caller;
my $fullerror='';my $allines='';
my $hostlabel=$self->{_hostlabel}->[0];
if ($login_id) {
my $new_cmd='';
($new_cmd,$stderr)=
Rem_Command::new('Rem_Command',$hostlabel,
'__new_master__',
$self->{_connect});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($stdout,$stderr)=$new_cmd->cmd($command,@args);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($new_cmd->{_cmd_pid},$kill_arg) if
&Net::FullAuto::FA_Core::testpid($new_cmd->{_cmd_pid});
$new_cmd->{_cmd_handle}->close;
&Net::FullAuto::FA_Core::release_fa_lock($sem) if $sem;
return $stdout,$stderr if $wantarray;
return $stdout if !$stderr;
return $stderr;
}
my $output='';my $stdout='';my $stderr='';my $pid_ts='';
my $end=0;my $newtel='';my $restart='';my $syntax=0;
my $doeval='';my $dots='';my $dcnt=0;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\nccccccc UNMODIFIED COMMAND as RECEIVED by Rem_Command::cmd() ccccccc: ".
"==>$command<== and LIVE=$live and THIS=$_[$#_-1]\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
eval {
$stdout='';
$stderr='';
$end=0;
my $line='';my $testline='';
my $testcmd='';my $ms_cmd='';
($ms_cmd=$command)=~tr/ //s;
$ms_cmd=(-1<index lc($command),'cmd /c') ? 1 : 0;
if (0 && !$live && $ms_cmd) {
print $Net::FullAuto::FA_Core::LOG "WEVE GOT WINDOWSCOMMAND=$command\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($self->{_uname} ne 'cygwin') {
($output,$stderr)=Rem_Command::cmd($self,
'uname',@args);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$stderr="remote OS is $output - NOT a cygwin system!\n";
&Net::FullAuto::FA_Core::handle_error($stderr);
}
$pid_ts=$self->{_cmd_pid}.'_'.$Net::FullAuto::FA_Core::invoked[0]
.'_'.$Net::FullAuto::FA_Core::increment++;
push @FA_Core::pid_ts, $pid_ts;
my $t=$self->{_work_dirs}->{_tmp_mswin}.'\\';
$t=~s/\\/\\\\/g;
$t=~s/\\$//mg;
my $str=" echo \"del ${t}end${pid_ts}.flg ${t}cmd${pid_ts}.bat"
." ${t}out${pid_ts}.txt ${t}err${pid_ts}.txt\""
." > ${t}rm${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my $cmmd='';
if (-1<index $command,"\n") {
my @command=split /\n/,$command;my $ccnt=0;
foreach my $cmd (@command) {
($cmmd=$cmd)=~s/^\s*[cC][mM][dD]\s+\/[cC]\s+(.*)$/$1/;
$cmmd=~tr/\'/\"/;
$cmmd=~s/\\/\\\\/g;
$cmmd=~s/\\$//mg;
$cmmd=~s/\"/\\\"/g;
if (!$ccnt++) {
if (unpack('a4',$cmmd) eq 'set ') {
$str=" echo \"$cmmd\""
." > ${t}cmd${pid_ts}.bat";
} else {
$str=" echo \"$cmmd 2>${t}err${pid_ts}.txt "
."1>${t}out${pid_ts}"
.".txt\" > ${t}cmd${pid_ts}.bat";
}
$self->{_cmd_handle}->print($str);
my $lastDB7=0;
DB7: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB7=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB7;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
$output=join '',$self->{_cmd_handle}->cmd(
String => $str,
Timeout => $cmtimeout
);
} else {
if (unpack('a4',$cmmd) eq 'set ') {
$str=" echo \"$cmmd\""
." >> ${t}cmd${pid_ts}.bat";
} else {
$str=" echo \"$cmmd 2>>${t}err${pid_ts}.txt "
."1>>${t}out${pid_ts}"
.".txt\" >> ${t}cmd${pid_ts}.bat";
}
$self->{_cmd_handle}->print($str);
my $lastDB8=0;
DB8: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB8=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB8;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
}
}
} else {
($cmmd=$command)=~s/^\s*[cC][mM][dD]\s+\/[cC]\s+(.*)$/$1/;
$cmmd=~tr/\'/\"/;
$cmmd=~s/\\/\\\\/g;
$cmmd=~s/\\$//mg;
$cmmd=~s/\"/\\\"/g;
$str=" echo \" $cmmd 2>${t}err${pid_ts}.txt 1>${t}out${pid_ts}"
.".txt\" > ${t}cmd${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
my $lastDB9=0;
DB9: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB9=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB9;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
}
$str=" echo \"echo \"DONE\" > ${t}end${pid_ts}.flg\" >>"
." ${t}cmd${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
my $lastDB10=0;
DB10: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB10=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB10;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
$self->{_cmd_handle}->
print(" echo \"exit\" >> ${t}cmd${pid_ts}.bat");
my $lastDB11=0;
DB11: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB11=1;last
} last if $line=~/$cmd_prompt$/s;
}
};
if ($lastDB11) {
$self->{_cmd_handle}->print(' echo ECHO');
eval {
my $echo=0;
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/ECHO/s) {
last if $line=~/$cmd_prompt$/s;
$echo=1;
} elsif ($echo==1) {
last if $line=~/$cmd_prompt$/s;
}
}
};
} last if $lastDB11;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
#print "RUNNING COMMANDBAT $cmmd\n";
$self->{_cmd_handle}->print(" cmd /c start ${t}cmd${pid_ts}.bat");
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
KC: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($self->{_cmd_handle} eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[3]=
"cmd /c start cmd${pid_ts}.bat";
last KC;
}
}
}
}
my $err_cownt=0;my $nowerr_cownt=0;
my $err_size=0;my $err_size_save=0;
($output,$stderr)=$self->cmd('pwd');
print "BIGGOOOPUTPUT=$output<== and PRE=$self->{_work_dirs}->{_pre} and TMP=$self->{_work_dirs}->{_tmp} and CWD=$self->{_work_dirs}->{_cwd}\n";
my $c=$self->{_work_dirs}->{_tmp}||
$self->{_work_dirs}->{_tmp_mswin};
my $loop_time=0;
LK: while (1) {
#$loop_time=time() if !$loop_time;
#if ($cmtimeout<time()-$loop_time) {
# ($output,$stderr)=$self->cmd("ls -l err${pid_ts}.txt");
# &Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
# my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
# my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;
# $output=~s/^.*\s+($rx1|$rx2)$/$1/;
# $output=~/^(\d+)\s+[JFMASOND]\w\w\s+\d+\s+\S+\s+.*$/;
# my $size=$1;
#print "CMDOUTPUTSIZE=$size<==\n";
# last if $size;
# $loop_time=0;
#}
my $shell_cmd=" if\n[[ -f ${c}end${pid_ts}.flg ]]\nthen" .
"\necho END\nelse\necho LOOKING\nfi\n";
$self->{_cmd_handle}->print($shell_cmd);
if ($self->{_cmd_handle}->errmsg) {
my $err=$self->{_cmd_handle}->errmsg;
&Net::FullAuto::FA_Core::handle_error($err);
} my $looptime=0;$allines='';
while (1) {
my $line=$self->{_cmd_handle}->
get(Timeout=>$cmtimeout);
$allines.=$line;
last if $allines=~/^(END|LOOKING)/m;
$self->{_cmd_handle}->print;
$looptime=time() if !$looptime;
if ($cmtimeout<time()-$looptime) {
my $lv_errmsg="read timed-out for command :"
."\n\n -> $cmmd"
."\n\n invoked on \'$hostlabel\'"
."\n\n Current Timeout "
."Setting is -> $cmtimeout seconds.\n\n";
$self->{_cmd_handle}->timeout($svtimeout);
if ($wantarray) {
die $lv_errmsg;
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
}
}
$allines=~s/\s*$//s;
if ($allines=~/^END/m) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my $err_outt='';
($err_outt,$stderr)=$self->cmd("ls -l ${c}err${pid_ts}.txt");
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$err_size='';
($err_size=$err_outt)
=~s/^\S+\s+\d+\s+\S+\s+\S+\s+(\d+).*$/$1/s;
if ($err_size!~/^\d+$/) {
($err_size=$err_outt)
=~s/^\S+\s+\d+\s+\S+\s+\S+\s+\S+\s+(\d+).*$/$1/s;
}
if ($err_size=~/^\d+$/) {
if ($err_size==$err_size_save &&
$nowerr_cownt+3<$err_cownt++) {
#my $cat_err='';
#($cat_err,$stderr)=$self->cmd(
# "cat ${c}err${pid_ts}.txt");
#print "CATERRRRRR=$cat_err<==\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
last LK;
#&Net::FullAuto::FA_Core::handle_error($cat_err);
} else { $err_size_save=$err_size }
}
last LK;
}
if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n Gathering MSWin Output $dots";
if ($dcnt++<5) {
$dots.=" .";
} else { $dots='';$dcnt=0 }
print "\n\n From Command => $cmmd\n\n";
} sleep 1;
}
print "GETTING THIS=${c}out${pid_ts}.txt\n";
my $trandir='';
unless ($self->{_uname} eq 'cygwin' &&
$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);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"get \"${c}out${pid_ts}.txt\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-3')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_lcd}\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
} else {
($output,$stderr)=&ftpcmd($self,
"get \"${c}out${pid_ts}.txt\"",$cache);
}
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);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"get \"${c}err${pid_ts}.txt\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-3')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_lcd}\"",
$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
} else {
($output,$stderr)=&ftpcmd($self,
"get \"${c}err${pid_ts}.txt\"",$cache);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
if ($Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp}) {
$trandir=$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp'};
if (substr($trandir,-1) ne '/') {
$trandir.='/';
}
}
($stdout,$stderr)=$localhost->cmd(
"cat ${trandir}out${pid_ts}.txt");
if ($stderr) {
my $die="$stderr\n\n From Command -> "
."\"cat ${trandir}out${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
my $cmd_error='';my $error='';
if ($err_size) {
($cmd_error,$stderr)=$localhost->cmd(
"cat ${trandir}err${pid_ts}.txt");
if ($stderr) {
my $die="$stderr\n\n From Command -> "
."\"cat ${trandir}err${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die,'-4');
}
}
my $out='';
if ($^O eq 'cygwin') {
($out,$error)=$localhost->cmd(
"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp_mswin'}
."\\\\out${pid_ts}.txt",
'__live__');
if ($error) {
my $die="$error\n\n From Command -> "
."\"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}-{'_tmp_mswin'}
."\\\\out${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
($out,$error)=$localhost->cmd(
"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp_mswin'}
."\\\\err${pid_ts}.txt",
'__live__');
if ($error) {
my $die="$error\n\n From Command -> "
."\"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp_mswin'}
."\\\\err${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
&Net::FullAuto::FA_Core::handle_error(
"$cmd_error\n\n From Command -> $cmmd",'-8')
if $cmd_error && !$wantarray;
} else {
($out,$error)=$localhost->cmd(
"rm -rf ${trandir}out${pid_ts}.txt");
if ($error) {
my $die="$error\n\n From Command -> "
."\"rm -rf ${trandir}out${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
($out,$error)=$localhost->cmd(
"rm -rf ${trandir}err${pid_ts}.txt");
if ($error) {
my $die="$error\n\n From Command -> "
."\"rm -rf ${trandir}err${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
}
$str=" echo \"del ${t}rm${pid_ts}.bat\""
." >> ${t}rm${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
$allines='';
while (my $line=$self->{_cmd_handle}->
get(Timeout=>$cmtimeout)) {
$allines.=$line;
last if $allines=~/$cmd_prompt$/s;
}
$self->{_cmd_handle}->print(" cmd /c ${t}rm${pid_ts}.bat");
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
if ($cmd_error) {
my $error="$cmd_error\n\n From Command -> $cmmd";
&Net::FullAuto::FA_Core::handle_error($error) if !$wantarray;
die "$error\n\n at $topcaller[0] "
."$topcaller[1] line ".__LINE__.".\n";
}
} elsif ($ftp) {
($stdout,$stderr)
=&ftpcmd($self->{_cmd_handle},$command,$cache);
if ($stderr) {
my $host=($self->{_hostlabel}->[1])
? $self->{_hostlabel}->[1]
: $self->{_hostlabel}->[0];
my $die="$stderr\n\n From Command -> "
."\"$command\"\n for \'$host\'\.";
&Net::FullAuto::FA_Core::handle_error($die,'-10');
}
} else {
my $bckgrd=0;
$bckgrd=1 if $command=~s/[\t ][&](?>\s*)$//s;
my $live_command='';
if ($command=~/^cd[\t ]/) {
$live_command=" $command 2>&1";
if (-1<$#{$self->{_hostlabel}} &&
$self->{_hostlabel}->[$#{$self->{_hostlabel}}]
eq "__Master_${$}__") {
my $lcd=$command;$lcd=~s/^cd[\t ]*//;
chdir $lcd;
}
} else {
$live_command=
' ('.$command.';echo $?)'." | sed -e 's/^/stdout: /' 2>&1";
}
$live_command.=' &' if $bckgrd;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\n+++++++ RUNNING FULLAUTO MODIFIED COMMAND +++++++: ".
"==>$live_command<==\n ",
"and ", "SELECT_TIMEOUT=$cmtimeout and KEYSSELF=",
(join ' ',@{[keys %{$self}]}),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
$self->{_cmd_handle}->timeout($cmtimeout);
$live_command=~s/\\\\/\\/g;
$live_command=~s/\\/\\\\/g;
$live_command=~s/\\$//mg;
$self->{_cmd_handle}->print($live_command);
my $growoutput='';my $ready='';my $firstout=0;
my $fulloutput='';my $lastline='';my $errflag='';
my $test_out='';my $first=-1;#my $starttime=0;
my $starttime=time();my $restart_attempt=1;my $nl='';
my $select_timeout=2;my $appendout='';my $retry=0;
my $command_stripped_from_output=0;
my $test_stripped_output='';
$self->{_cmd_handle}->autoflush(1);my $save='';
my $loop_count=0;my $loop_max=5;my $fetchflag=0;
my $test_for_no_output=0;
FETCH: while (1) {
my $output='';$nl='';$loop_count++;
my $tim=time()-$starttime;
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "INFO: ======= AT THE TOP OF MAIN OUTPUT LOOP =======;".
" at Line ".__LINE__."\n" if $first || $starttime;
print "INFO: STARTTIME=$starttime and TIMENOW=",time(),
" and TIMEOUT=$cmtimeout and Diff=$tim\n";
}
print $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
if ($select_timeout!=2 && $select_timeout==$tim) {
$self->{_cmd_handle}->print("\003");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle},$tim,$command);
&Net::FullAuto::FA_Core::handle_error(
$cfh_error,'-2','__cleanup__')
if $cfh_error;
my $errhost='';
if ($hostlabel eq "__Master_${$}__") {
$errhost=$Net::FullAuto::FA_Core::local_hostname;
} else { $errhost=$hostlabel }
my $lv_errmsg=$growoutput
."\n\n read timed-out for command :"
."\n\n -> $live_command"
."\n\n invoked on \'$errhost\'"
."\n\n Current Timeout "
."Setting is -> $cmtimeout seconds.\n\n";
$self->{_cmd_handle}->timeout($svtimeout);
if ($wantarray) {
die $lv_errmsg;
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
} elsif (select
$ready=${${*{$self->{_cmd_handle}}}{net_telnet}}{fdmask},
'', '', $select_timeout) {
alarm($select_timeout+10);
sysread $self->{_cmd_handle},$output,
${${*{$self->{_cmd_handle}}}{net_telnet}}{blksize},0;
alarm(0);
print $Net::FullAuto::FA_Core::LOG
"INFO: Got past the Timeout Alarm; at Line ".__LINE__."\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$output=~s/[ ]*\015//g;
$output=~tr/\0-\11\13-\37\177-\377//d;
if (-1<index $output,'[A') {
$output=~s/^(.*2[>][&]1\s*)\[A\s*$/$1/s;
} elsif (-1<index $output,'7[r') {
$output=~s/7[[]r[[]999[;]999H[[]6n//s;
}
print $Net::FullAuto::FA_Core::LOG
"\nCMD RAW OUTPUT: ==>$output<== at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "\nCMD RAW OUTPUT: ==>$output<== at Line ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
$first=1 if $first==0;
if (!$firstout) {
$firstout=1;
if ($output=~/^\s*$cmd_prompt$/) {
print "INFO: Got PROMPT - $cmd_prompt; ".
"Setting \$firstout=1 and next FETCH\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
next;
} else {
print "INFO: Setting \$firstout=1 and CONTINUING\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
}
}
if ($first<0) {
print "\nOUTPUT BEFORE NEW LINE ENCOUNTERED: ",
"==>$output<== :\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nOUTPUT BEFORE NEW LINE ENCOUNTERED: ==>$output<== :",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($appendout) {
$output="$appendout$output";
$appendout='';
$test_stripped_output=$output;
} else {
$test_stripped_output.=$output;
}
$test_stripped_output=~s/\s*//gs;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $lslc=length $stripped_live_command;
my $ltso=length $test_stripped_output;
if (($test_stripped_output eq $stripped_live_command) ||
(($lslc<$ltso) &&
(substr($test_stripped_output,-$lslc) eq
$stripped_live_command))) {
print "\nSTRIPPED OUTPUT equals STRIPPED LIVE COMMAND",
" at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nSTRIPPED OUTPUT equals STRIPPED LIVE COMMAND",
" at Line ",__LINE__,"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
$command_stripped_from_output=1;
$output='';
$first=0;next;
} elsif ($output=~/\n/s) {
print "\nNNNNNNN OUTPUT HAS NEW LINE CHAR NNNNNNN ".
"RAW OUTPUT: ==>$output<== ".
"\n\n TEST_STRIPPED_OUTPUT=$test_stripped_output".
"\n\n STRIPPED_LIVE_COMMAND=$stripped_live_command".
"\n\n at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*') &&
$loop_count<$loop_max;
die 'logout' if $output=~/imed out/s
|| $output=~/logout$|closed\.$/mg;
if (-1<index $output,'[A[C[C') {
my $one='';my $two='';my $thr='';
my $qrx=qr/\s*stdout:.*|\s*_funkyPrompt_/;
my $grx=qr/(?:\[A(?:\[C)+(?:\[K1)*)/;
$output=~/^(.*&1)$grx(.*?)($qrx)*(\s*|'')$/s;
$one=$1 if defined $1;
$two=$2 if defined $2;
$thr=$3 if defined $3;
$output=$one.$two.$thr;
$test_stripped_output=~s/$grx//s;
$ltso=length $test_stripped_output;
}
my $last_line='';
$output=~/^.*\n(.*)$/s;
$last_line=$1;
$last_line||='';
my $ptest=substr($output,(rindex $output,'|'),-1)
if -1<index $output,'|';
$ptest||=$output;
$ptest=~s/\s*//g;$ptest||='';
if ($last_line && ($last_line=~/$cmd_prompt$/s
|| $bckgrd)) {
print "LAST_LINE=$last_line and OUTPUT=$output<=\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "LAST_LINE=$last_line and OUTPUT=$output<=\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print "LSLC=$lslc and LTSO=$ltso and UNPACK=",unpack("a$lslc",$test_stripped_output)," and STIPPEDLIVECMD=$stripped_live_command\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
if (($lslc<$ltso) &&
(unpack("a$lslc",$test_stripped_output) eq
$stripped_live_command)) {
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
my $llc=length $live_command;
my $oup=unpack("a$llc",$output);
if ($oup ne $live_command) {
print $Net::FullAuto::FA_Core::LOG "OUPPPPPPPPPPPP=$oup\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (substr($oup,-1) eq 's') {
$llc--;
$output=unpack("x$llc a*",$output);
} else {
my $o=$output;my $c=0;
while (1) {
last if $c++==5;
$o=~s/^(.*?)\n(.*)$/$1$2/s;
print $Net::FullAuto::FA_Core::LOG "ONNNNNNNNNN=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $op=unpack("a$llc",$o);
print $Net::FullAuto::FA_Core::LOG "OPPPPPPPPPPP=$op<== and LC=$live_command<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($op eq $live_command) {
print $Net::FullAuto::FA_Core::LOG "OOOOOOOOOOOO=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$op=unpack("x$llc a*",$o);
$output=$op;last;
}
}
}
} elsif (substr($oup,-1) eq 's') {
$llc--;
$output=unpack("x$llc a*",$output);
} else {
$output=unpack("x$llc a*",$output);
}
$first=0;$growoutput=$output;
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;
print $Net::FullAuto::FA_Core::LOG "GRO_OUT_AFTER_MEGA_STRIP=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*');
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
# Strip noise characters
$output=~s/^.*?(stdout:.*)$/$1/s;
print $Net::FullAuto::FA_Core::LOG "GRO_OUT_AFTER_NOISE_STRIP=$output\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*');
$growoutput=$output;
$output='';
$command_stripped_from_output=1;
}
$output='';
} elsif (($lslc<$ltso) &&
(-1<index $test_stripped_output,
$stripped_live_command)) {
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
$growoutput=$output;
$output='';
#$growoutput
# =~s/^.*$live_command(.*)$cmd_prompt$/$1/s;
$command_stripped_from_output=1;
}
$output='';
} elsif ((-1<index $output,'stdout:') &&
$output=~s/^\s*(stdout.*
\n$cmd_prompt)$/$1/sx) {
$save=&display($output,$cmd_prompt,$save)
if $display;
$growoutput.=$output;$output='';
print $Net::FullAuto::FA_Core::LOG "FIRST_EIGHT_AND_A_HALF\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;
} else {
my $stripang_live_command=$stripped_live_command;
$stripang_live_command=~s/[>]//gs;
my $lsac=(length $stripang_live_command)+1;
if ($lsac==$lslc) {
$output=unpack("x$ltso a*",$output);
print $Net::FullAuto::FA_Core::LOG "FIRST_NINE_HALF and 1=$lslc and ",
"2=$ltso and 3=$lsac and ",
"OUTPUT=$output<== 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::LOG,'*';
if ($output=~s/^\s*(stdout.*
\n$cmd_prompt)$/$1/sx) {
$save=&display($output,$cmd_prompt,$save)
if $display;
$growoutput.=$output;$output='';
$first=0;
} else {
$growoutput=$output;$output='';
$command_stripped_from_output=1;
}
}
if (!$first && !$command_stripped_from_output) {
my $tsst=unpack("a$lslc",
$test_stripped_output);
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
$save=&display($last_line,$cmd_prompt,$save)
if $display;
$first=0;$growoutput.=$last_line;
$growoutput=~s/^.*($cmd_prompt)$/$1/s;
$output='';
}
}
} elsif ($ptest eq
"|sed-e's/^/stdout:/'2>&1") {
print $Net::FullAuto::FA_Core::LOG "FIRST_TEN\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;next;
} elsif (unpack('a7',$output) eq 'stdout:') {
print $Net::FullAuto::FA_Core::LOG "FIRST_ELEVEN\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;
} else {
print $Net::FullAuto::FA_Core::LOG "HERE WE ARE AT A PLACE3 and GO=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
$appendout=$output;next
}
if (!$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug) {
print "WE DID NOTHING TO STDOUT - $output\n";#sleep 2;
}
print $Net::FullAuto::FA_Core::LOG "WE DID NOTHING TO STDOUT - $output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
#open(BK,">brianout.txt");
#print BK "$output";
#CORE::close BK;
#print "OPUT=$output<== and ",`od -a brianout.txt`,"\n";
#unlink "brianout.txt";
#open(BK,">brianout.txt");
#print BK "$lv_cmd";
#CORE::close BK;
#print "LV_CMD=$lv_cmd<== and ",`od -a brianout.txt`,"\n";
#unlink "brianout.txt";
#print "EXAMINERR=>OPUT=$output<= and LV_CMD=$lv_cmd<=\n";
} else { $appendout=$output;next }
}
print $Net::FullAuto::FA_Core::LOG "PAST THE ALARM3\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print "OUTPUT ***After First-Line Loop***=$output<== and COMSTROUT=$command_stripped_from_output and GROWOUTPUT=$growoutput<==\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::LOG "OUTPUTNOWWWWWWWWWWW=$output<== and STRIPPED=$command_stripped_from_output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
#print "\n\nOUTPUTNOWWWWWWWWWWW=$output<== and STRIPPED=$command_stripped_from_output\n\n";
if ($command_stripped_from_output) {
print $Net::FullAuto::FA_Core::LOG "GOT STRIPPED_COMMAND_FLAG AND GROWOUTPUT=$growoutput<==\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
my $lcp=length $cmd_prompt;
$lcp+=18;
unless ($growoutput) {
print $Net::FullAuto::FA_Core::LOG "NO GROWOUTPUTTTTTTTTTTTTT\n" if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*');
if ($output && unpack('a1',$output) eq '[') {
if ($output=~/^\[A(\[C)+\[K1\s*/s) {
next FETCH;
}
}
if ($output=~/^\s?$cmd_prompt/) {
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
my $tou=$output;
$tou=~s/^\s?$cmd_prompt\s*//;
my $ltu=length $tou;
$test_stripped_output=$tou;
$test_stripped_output=~s/\s*//gs;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $lslc=length $stripped_live_command;
my $ltso=length $test_stripped_output;
if (($lslc<$ltso) &&
(unpack("a$lslc",$test_stripped_output) eq
$stripped_live_command)) {
my $llc=length $live_command;
$growoutput=unpack("x$llc a*",$tou);
print $Net::FullAuto::FA_Core::LOG "KKKKKKKSSSSSSSSSSSSKKKKKKKK\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;$output='';$fulloutput='';
$command_stripped_from_output=1;
if ($growoutput=~/$cmd_prompt$/s) {
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;
chomp($growoutput);
$growoutput.="\n".$cmd_prompt;
$lastline=$cmd_prompt;
} else {
$growoutput='';
next FETCH;
}
} elsif ($output ne $cmd_prompt &&
$output!~/^\s*($cmd_prompt\s*)+$/s) {
print $Net::FullAuto::FA_Core::LOG "PPPPPPPPPPPPPPPPPPPPPPPPPPPTOU=$tou and FETCHFLAG=$fetchflag\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=-1;
$fulloutput='';
$command_stripped_from_output=0;
$appendout=$tou;
$fetchflag=1;
next FETCH;
} last FETCH;
} elsif (-1<index $output,'Connection reset by peer') {
$fullerror.=$output;
last FETCH;
} elsif ($output=~/^\s?$/) {
next FETCH;
} elsif ($output=~/^(stdout: .*)$cmd_prompt$/) {
$growoutput=$1."\n".$cmd_prompt;
$lastline=$cmd_prompt;
$output='';$fulloutput='';
} elsif ($fetchflag) {
print $Net::FullAuto::FA_Core::LOG "FETCHFLAGGGGGGGGGG=$fetchflag\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$save=&display($output,$cmd_prompt,$save)
if $display;
$growoutput.=$output;
next FETCH
}
} elsif (($output=~/^stdout: (?!\/')/) &&
($growoutput=~/ 2\>&1\s?$/)) {
$growoutput=$output;
if ($output!~/$cmd_prompt$/s) {
$save=&display($output,$cmd_prompt,$save)
if $display;
next FETCH
}
$output='';$fulloutput='';
} elsif ($growoutput && $output eq $cmd_prompt) {
chomp $growoutput;
$growoutput.="\n".$cmd_prompt;
$lastline=$cmd_prompt;
$output='';$fulloutput='';
} elsif ($output=~/$cmd_prompt$/s) {
$growoutput.=$output;
$lastline=$cmd_prompt;
$save=&display($output,$cmd_prompt,$save)
if $display;
$output='';$fulloutput='';
} elsif (unpack("a$lcp",$output) eq
$cmd_prompt.'cmd /Q /C "set /A ') {
$lastline=$cmd_prompt;
$output='';$fulloutput='';
}
} elsif ($output eq 'Connection closed') {
if ($wantarray) {
return 0,$output;
} else {
&Net::FullAuto::FA_Core::handle_error($output)
}
} elsif ($output eq '>') {
if (substr($growoutput,-1) eq '2') {
$growoutput.=$output;
$first=-1;
$save=&display($output,$cmd_prompt,$save)
if $display;
next FETCH;
}
my $die="The Command:\n\n $command"
."\n\nHas a Syntax Error. The Command "
."Shell\n Entered Interacive Mode '>'";
if ($wantarray) {
return 0,$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die)
}
}
#print "OUTPUT==>$output<== and Save=$save<===\n" if $output=~/^ 286/;
$output=~s/^[ |\t]+(stdout:.*)$/$1/m if !$fullerror;
$save=&display($output,$cmd_prompt,$save)
if $display;
$growoutput.=$output;
#if ($Net::FullAuto::FA_Core::debug) {
#open(BK,">brianout.txt");
#print BK "$growoutput";
#CORE::close BK;
#print "OD_GROWOUTPUT=$growoutput<== and ",`od -a brianout.txt`,"\n";
#unlink "brianout.txt";
#}
$test_out="\$growoutput";
if (!$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug) {
print "THISEVALLL=",($test_out=~/$cmd_prompt$/s),
" and OUT=$output and CMD_PROMPT=$cmd_prompt\n";
}
if (15<length $growoutput &&
unpack('a16',$growoutput) eq '?Invalid command') {
$self->{_cmd_handle}->timeout($svtimeout);
&Net::FullAuto::FA_Core::handle_error(
"?Invalid Command ftp> -> $live_command");
} elsif (-1<index lc($growoutput),'killed by signal 15') {
die 'Connection closed';
} elsif ((-1==index $growoutput,'stdout:') &&
(-1<index $growoutput,' sync_with_child: ')) {
&Net::FullAuto::FA_Core::handle_error(
$growoutput,'__cleanup__');
} elsif (1<($growoutput=~tr/\n//) ||
$growoutput=~/($cmd_prompt)$/s) {
my $oneline=$1;$oneline||=0;
($lastline=$growoutput)=~s/^.*\n(.*)$/$1/s;
print "NOWLASTLINE=$lastline<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "NOWLASTLINE=$lastline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($lastline eq $growoutput &&
$growoutput=~/$cmd_prompt$/s
&& (length $growoutput<7 ||
unpack('a7',$growoutput) ne 'stdout:')) {
print $Net::FullAuto::FA_Core::LOG "FIRST_THIRTEEN\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;
$growoutput='';
} else {
if ($growoutput=~/$cmd_prompt/s) {
print "GROWOUTPUT2=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "GROWOUTPUT2=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
if ($growoutput=~/stdout: PS1=/m) {
($lastline=$growoutput)=~s/^.*\n(.*)$/$1/s;
} elsif ($growoutput=~s/^\n*$cmd_prompt\n*//s) {
my $test_stripped_output=$growoutput;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $testgrow=$test_stripped_output;
$testgrow=~s/^(.*?2>&1\n?)(.*)$/$1/s;
my $thisout=$2;
$testgrow=~s/\s*//gs;
if ($testgrow eq $stripped_live_command) {
$growoutput=$thisout;
}
my $lvc=$live_command;
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/ );
next FETCH if !$growoutput;
if (-1<index $growoutput,'stdout: /') {
my $stub=substr($growoutput,0,
(index $growoutput,'stdout: /'));
if (substr($live_command,0,(length $stub))
eq $stub) {
my $go=$growoutput;
$growoutput=substr($go,(length $stub));
}
} elsif ((-1<index $live_command, $growoutput) &&
(substr($live_command,0,
(length $growoutput)) eq $growoutput)) {
$growoutput='';next FETCH;
}
if ($growoutput) {
if ($growoutput=~/^\s*$cmd_prompt$/s) {
$growoutput='';
last FETCH;
} elsif ($growoutput!~/$cmd_prompt$/) {
next FETCH;
}
}
print "CLEANEDGROWOUT=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::LOG "CLEANEDGROWOUT=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
} elsif ((-1<index $growoutput,$live_command) &&
(-1<index $growoutput,'[C[C[K1')) {
$growoutput=~s/\[A(\[C)+\[K1//s;
}
} elsif (!$lastline) {
my $tmp_grow=$growoutput;
chomp $tmp_grow;
($lastline=$tmp_grow)=~s/^.*\n(.*)$/$1/s;
$lastline.="\n";
}
my $l=length $live_command;
if ($first<0) {
print $Net::FullAuto::FA_Core::LOG "FIRST_FOURTEEN and GROW=$growoutput<===\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
if ($growoutput=~/2\s*>\s*&1\s*$/s) {
print $Net::FullAuto::FA_Core::LOG "FIRST_FOURTEENa\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;$growoutput='';
$output='';
} elsif ($oneline) {
print $Net::FullAuto::FA_Core::LOG "FIRST_FOURTEENb\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($growoutput=~s/^$live_command//) {
print $Net::FullAuto::FA_Core::LOG "FIRST_FOURTEENc\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;
}
} else {
print $Net::FullAuto::FA_Core::LOG "FIRST_FOURTEENd\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$growoutput=~s/^(.*?)\012//s;
my $f_line=$1;
if ($f_line=~/[2]\s*[>]\s*[&][1]\s*$/s) {
print $Net::FullAuto::FA_Core::LOG "FIRST_FOURTEENe\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$first=0;
}
}
} elsif ($command_stripped_from_output==0) {
print $Net::FullAuto::FA_Core::LOG "FIRST_TEENeeee and GO=$growoutput\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $test_stripped_output=$growoutput;
$test_stripped_output=~s/\s*//gs;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $lslc=length $stripped_live_command;
my $ltso=length $test_stripped_output;
print $Net::FullAuto::FA_Core::LOG "TEEN1=",substr($test_stripped_output,-$lslc),"<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
print $Net::FullAuto::FA_Core::LOG "TEEN2=$stripped_live_command<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (($lslc<$ltso) &&
(unpack("a$lslc",$test_stripped_output) eq
$stripped_live_command)) {
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*
';
my $llc=length $live_command;
my $oup=unpack("a$llc",$output);
if ($oup ne $live_command) {
print $Net::FullAuto::FA_Core::LOG "OUPPPPPPPPPPPPTTTTTTT=$oup\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
#my $o=$output;my $c=0;
my $o=$growoutput;my $c=0;
while (1) {
last if $c++==5;
$o=~s/^(.*?)\n(.*)$/$1$2/s;
print $Net::FullAuto::FA_Core::LOG "ONNNNNTTTT=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $op=unpack("a$llc",$o);
print $Net::FullAuto::FA_Core::LOG "OPPPPPPTTTTP=$op<== and LC=$live_command<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($op eq $live_command) {
print $Net::FullAuto::FA_Core::LOG "OOOOOOOOTTTT=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$op=unpack("x$llc a*",$o);
$output=$op;last;
} elsif (substr($op,-1) eq 's') {
$llc--;
$op=unpack("x$llc a*",$o);
$output=$op;last;
}
}
} else {
$output=unpack("x$llc a*",$output);
}
$first=0;$growoutput=$output;
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;
print $Net::FullAuto::FA_Core::LOG "GRO_OUT_AFTER_MEGA_STRIPTTTTTTTTTT=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*');
$command_stripped_from_output=1;
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
$growoutput=$output;
$save=&display($output,$cmd_prompt,$save)
if $display;
$lastline=$cmd_prompt;
} else {
next FETCH;
}
} elsif ($growoutput=~/^stdout:.*stdout:/s) {
$command_stripped_from_output=1;
}
print $Net::FullAuto::FA_Core::LOG "FIRST_FifTEENe and GO=$growoutput\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
}
}
print "DONE TRIMMING GROWOUTPUT=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
#print $Net::FullAuto::FA_Core::LOG "DONE TRIMMING GROWOUTPUT=$growoutput<==\n".
# "and FULLOUT=$fulloutput<==\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($growoutput) {
if ($wantarray) {
my @strings=split /^/, $growoutput;
my $str_cnt=$#strings;
#print "CLEARING FULLOUTPUT\n";<STDIN>;
$fulloutput='';
foreach my $line (@strings) {
print "LETS LOOK AT LINE=$line<== and LASTLINE=$lastline<==\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::LOG "LETS LOOK AT LINE=$line<== and LASTLINE=$lastline<==\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
if ($line ne $lastline || 0<$str_cnt) {
$str_cnt--;
if ($line=~s/^stdout: ?//) {
$fulloutput.=$line;
$errflag='';
} elsif (($line!~/^\[[AK]$|^\n$/s &&
$line ne $live_command &&
$line!~/\s-e\s\'s\/\^\/stdout
\:\s*\/\'\s2\>\&1\s*$/sx) ||
($fullerror && $line=~/^\n$/s)) {
#print "DOIN FULLERROR1==>$line<== and STRCNT=$str_cnt\n";# if $Net::FullAuto::FA_Core::debug;
#print $Net::FullAuto::FA_Core::LOG "DOIN FULLERROR1==>$line<==\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (!$line) {
my $lastDB43=0;my $testline='';
DB43: while (1) {
print $Net::FullAuto::FA_Core::LOG "WE ARE INSIDE DB43\n";
$self->{_cmd_handle}->autoflush(1);
$self->{_cmd_handle}->print(' echo FAECHO');
eval {
while (my $line=$self->{_cmd_handle}->get) {
$line=~tr/\0-\11\13-\37\177-\377//d;
($testline=$line)=~s/\s//g;
print "DB43output=$testline<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "DB43output=$testline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($testline=~/^$cmd_prompt$/) {
$lastDB43=1;last
}
if ($testline=~s/$cmd_prompt$//s) {
$line=~s/$cmd_prompt$//s;
$output.=$line;last;
} else { $output.=$line }
}
#print "DONEWITHDB43WILE and OUTPUTNOW=$output\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "DONEWITHDB43WHILE and OUTPUTNOW=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
}; $self->{_cmd_handle}->autoflush(0);
last if $lastDB43;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
my $tst_out=$output;
$tst_out=~s/\s*//gs;
print "TST_OUTTTTT=$tst_out<==\n";
print $Net::FullAuto::FA_Core::LOG "TST_OUTTTT=$tst_out<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
}
if ($fullerror && !$errflag) {
$fullerror.="\n";
} $errflag=1;
$fullerror.=$line;
#print "\n\nLINENOWWWW=$line<==\n\n";
#&display($line,$cmd_prompt,$save,
# $live_command) if $display;
} elsif ($fulloutput || $line!~/^\s*$/s) {
$fulloutput.=$line;
$save=&display($line,$cmd_prompt,$save)
if $display;
$errflag='';
} elsif ($display) {
$save=&display($line,$cmd_prompt,$save);
}
}
}
} elsif ($fulloutput || $line!~/^\s*$/s) {
print "HOW OFTEN IS FULL GETTINNG IT?=$loop_count\n";
$fulloutput.=$growoutput;
} elsif ($growoutput) {
$growoutput=~s/$cmd_prompt$//s;
$growoutput=~s/^stdout: ?//mg;
$fulloutput=$growoutput;
}
}
print "GROW_ADDED_TO_FULL=$growoutput<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::LOG "GROW_ADDED_TO_FULL=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
if ($growoutput) {
if ($log && -1<index $Net::FullAuto::FA_Core::LOG,'*') {
print $Net::FullAuto::FA_Core::LOG $growoutput if $loop_count<$loop_max;
}
#&display($output,$cmd_prompt,$save) if $display;
}
if ($loop_count<$loop_max) {
my $lcntt=0;my $newline='';
foreach my $line (reverse split /^/, $fulloutput) {
$newline=$line.$newline;
last if $lcntt++==5;
}
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
}
if (!$lastline) {
if ($retry++<3) {
my $forcedoutput='';
DB18: while (1) {
if ($retry<2) {
$self->{_cmd_handle}->print;
} else {
print "THIRTEEN003\n";
$self->{_cmd_handle}->print("\003");
}
my $oline='';
while (my $line=$self->{_cmd_handle}->get) {
$oline=$line;
$line=~s/\s//g;
last DB18 if $line=~/^$cmd_prompt$/;
$forcedoutput.=$oline;
last if $line=~/$cmd_prompt$/s;
}
} $forcedoutput||='';
$forcedoutput=~s/^$cmd_prompt$//gm;
foreach my $line (split /^/, $forcedoutput) {
if ($line=~s/^stdout: ?// &&
($fulloutput || $line!~/^\s*$/s)) {
$fulloutput.=$line;
$save=&display($line,$cmd_prompt,$save)
if $display;
$errflag='';
} elsif ($line!~/^\s*$/ &&
$line ne "$live_command\n" &&
$line ne " -e 's/^/stdout:/' 2>&1\n"
|| $fullerror && $line=~/^\n$/s) {
print "DOIN FULLERROR2222==>$line<==\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "DOIN FULLERROR2222==>$line<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($fullerror && !$errflag) {
$fullerror.="\n";
} $errflag=1;
$fullerror.=$line;
if ($fullerror) {
if ($log && -1<index $Net::FullAuto::FA_Core::LOG,'*') {
print $Net::FullAuto::FA_Core::LOG $fullerror;
}
$save=&display($line,$cmd_prompt,$save)
if $display;
}
}
}
if ($ms_cmd) {
$stdout=$fullerror;
} else {
$stdout=$fulloutput;
$stderr=$fullerror;
}
chomp $stdout if $stdout;
chomp $stderr if $stderr;
last FETCH;
}
my $warng="\n WARNING! The Command\n\n"
." ==>$live_command\n\n "
."Appears to be Hanging\,in an "
."Infinite Loop\,\n or Stopped.\n"
." Press <CTRL>-C to Quit.\n\n";
print $Net::FullAuto::FA_Core::LOG $warng
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq
'notify_on_error') {
my $subwarn="WARNING! Command Appears "
."to be Hanging or Stopped";
my %mail=(
'Body' => "$warng",
'Subject' => "$subwarn"
);
&Net::FullAuto::FA_Core::send_email(\%mail);
}
if ($ms_cmd) {
$stdout=$fullerror;
} else {
$stdout=$fulloutput;
$stderr=$fullerror;
}
chomp $stdout if $stdout;
chomp $stderr if $stderr;
last;
} elsif (-1<index $lastline, $cmd_prompt) {
print "WE HAVE LASTLINE CMDPROMPT AND ARE GOING TO EXIT and FO=$fulloutput and MS_CMD=$ms_cmd<==\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
$stdout=$fulloutput;
$stderr=$fullerror;
chomp $stdout if $stdout;
chomp $stderr if $stderr;
last;
} elsif ($lastline=~/^\s*$/) {
$growoutput.=$lastline;
} elsif (!$command_stripped_from_output) {
$growoutput=$lastline;
}
print $Net::FullAuto::FA_Core::LOG "GRO_GONNA_LOOP==>$growoutput<==\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
$starttime=0;$select_timeout=0;
} elsif (15<length $growoutput &&
unpack('a16',$growoutput) eq '[sudo] password ') {
$self->{_cmd_handle}->print(
&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$username));
} else {
$starttime=time();$select_timeout=$cmtimeout;
$restart_attempt=1;
}
$command_stripped_from_output=1;
print $Net::FullAuto::FA_Core::LOG "PAST THE ALARM4\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $Net::FullAuto::FA_Core::LOG "GRO_OUT AT THE BOTTOM==>$growoutput<==\n"
if $Net::FullAuto::FA_Core::log &&
(-1<index $Net::FullAuto::FA_Core::LOG,'*') && $loop_count<$loop_max;
} elsif ($starttime && (($cmtimeout<time()-$starttime)
|| ($select_timeout<time()-$starttime))) {
#print $Net::FullAuto::FA_Core::LOG "ELSFI AT THE BOTTOM==>$growoutput<==\n";
if (!$restart_attempt) {
print "FOURTEEN003\n";
$self->{_cmd_handle}->print("\003");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle},'',$command);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my $lv_errmsg="read timed-out for command :"
."\n\n -> $live_command"
."\n\n invoked on \'$hostlabel\'"
."\n\n Current Timeout "
."Setting is -> $cmtimeout seconds.\n\n";
$self->{_cmd_handle}->timeout($svtimeout);
if ($wantarray) {
die $lv_errmsg;
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
} else {
$restart_attempt=0;
$starttime=time();$select_timeout=$cmtimeout;
$self->{_cmd_handle}->print;
}
} elsif (!$starttime) {
$starttime=time();$select_timeout=$cmtimeout;
$restart_attempt=1;
}
}
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEE\n";
$stderr=$lastline if $lastline=~/Connection to.*closed/s;
print $Net::FullAuto::FA_Core::LOG "cmd() STDERRBOTTOM=$stderr<== and LASTLINE=$lastline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($stderr!~s/^\s*$//s && $stderr ne '_funkyPrompt_') {
chomp($stderr);
&Net::FullAuto::FA_Core::handle_error($stderr) if !$wantarray;
}
$stderr='' if $stderr eq '_funkyPrompt_';
if (-1<index $stderr,'_funkyPrompt_') {
my $test_stderr=$stderr;
$test_stderr=~s/_funkyPrompt_//g;
$test_stderr=~s/^\s*$//;
$stderr='' unless $test_stderr;
}
}
};
&display("\n",$cmd_prompt,'')
if $display && $stdout && $stdout!~/^\s+$/s;
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEXXXXXXXXXXX\n";
$self->{_cmd_handle}->autoflush(0)
if defined fileno $self->{_cmd_handle};
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEUUUUUUUUUUU\n";
my $eval_error='';
if ($@) {
print "\nEEEEEEE *just thrown* EEEEEEE RAW ERROR: $@".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Contents of \$stderr if any (raw error could be different):".
"\n $stderr\n".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
$eval_error=$@;undef $@;
}
if ($ftp) {
$self->{_ftp_handle}->timeout($svtimeout);
} else {
$self->{_cmd_handle}->timeout($svtimeout);
}
$eval_error=$stderr if $stderr && !$eval_error;
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEOOOOOOOOOOOOO\n";
if ($eval_error) {
$eval_error=~tr/\0-\11\13-\37\177-\377//d;
chomp($eval_error);
$eval_error=~s/^\s+//;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
print "\n",(caller(2))[3]," CLEANED (eval) ERROR:\n ",
"==>$eval_error<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
&Net::FullAuto::FA_Core::release_fa_lock($sem) if $sem;
if ((-1<index $command,"kill ") &&
(-1<index $eval_error,"eof")) {
my $prc=substr($command,-3);
if ($wantarray) {
return "process \#$prc killed","";
} else { return "process \#$prc killed" }
} $login_retry++;
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
my $num_of_err_lines=0;
($num_of_err_lines=$eval_error)=~tr/\n//;
$num_of_err_lines=0 if $num_of_err_lines!~/^\d+$/;
if ((-1<index $eval_error,'logout') ||
(-1<index $eval_error,'Connection closed') ||
((-1<index $eval_error,'read timed-out') &&
(40<$num_of_err_lines))
&& !$login_retry && !$cleanup) {
print $Net::FullAuto::FA_Core::LOG "MADE IT TO LOGOUT ERROR HANDLING\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $sav_self=$self->{_cmd_handle};
my $curdir=$self->{_work_dirs}->{_cwd}
|| $self->{_work_dirs}->{_cwd_mswin};
print $Net::FullAuto::FA_Core::LOG "CURDIR=$curdir\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($self->{_cmd_pid},$kill_arg) if
&Net::FullAuto::FA_Core::testpid($self->{_cmd_pid});
$self->{_cmd_handle}->close;
if (!exists $same_host_as_Master{$self->{_hostlabel}->[0]}) {
($self,$stderr)=&Net::FullAuto::FA_Core::connect_host(
$self->{_hostlabel}->[0],$cmtimeout);
} else {
($self,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',
$self->{_connect});
}
print $Net::FullAuto::FA_Core::LOG "GOT NEW SELF=$self and CURDIR=$curdir\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
$self->cwd($curdir);
CH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($sav_self
eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
substr($type,0,3)='cmd';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last CH;
}
}
}
} next if $self;
} elsif (!$ftp && !$login_retry && !$notrap && !$cleanup
&& (-1==index $eval_error,'space in the')) {
print "\nrrrrrrr RECOVERING rrrrrrr from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Attempting to retrieve new handle with &login_retry()\n".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
my $save_cwd='';
if (exists $self->{_work_dirs}->{_cwd_mswin}
&& $self->{_work_dirs}->{_cwd_mswin}=~/^\\\\/) {
$save_cwd=$self->{_work_dirs}->{_tmp}||'';
} else {
$save_cwd=$self->{_work_dirs}->{_cwd}||'';
}
print $Net::FullAuto::FA_Core::LOG
"WHAT HANDLE IS GOING INTO LOGIN_RETRY???=$self->{_cmd_handle}\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
($self->{_cmd_handle},$eval_error)=
&login_retry($self->{_cmd_handle},
$self->{_connect},
$self->{_cmd_type},$eval_error);
print $Net::FullAuto::FA_Core::LOG
"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::LOG,'*';
if ($self->{_cmd_handle}) {
print "\nrrrrrrr RECOVERING rrrrrrr from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Attempting to use new handle to change to saved cwd:".
"\n $save_cwd".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
($output,$stderr)=$self->cwd($save_cwd);
print $Net::FullAuto::FA_Core::LOG "WHAT IS CWD SAVE_CWD STDERR OUTPUT=$stderr<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$eval_error;
} else { &Net::FullAuto::FA_Core::handle_error($eval_error) }
} else {
print "\nRRRRRRR recovered RRRRRRR from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\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::LOG,'*';
next
}
}
}
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
$eval_error=~s/_funkyPrompt_//gs if $eval_error &&
-1<index $eval_error,'_funkyPrompt_';
if ($wantarray) {
print $Net::FullAuto::FA_Core::LOG "WE ARE RETURNING ERROR=$eval_error\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my @stdout_contents=split "\n",$stdout;
my $exitcode=pop(@stdout_contents);
$exitcode=-1 unless defined $exitcode;
$stdout=join "\n", @stdout_contents;
$stdout||='';
return $stdout,$eval_error,$exitcode;
} else { &Net::FullAuto::FA_Core::handle_error($eval_error) }
}
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEMMMMMMMMMM\n";
pop @FA_Core::pid_ts if $pid_ts;
$stdout||='';$stderr||='';
&Net::FullAuto::FA_Core::release_fa_lock($sem) if $sem;
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
my $exitcode=0;
if ($stdout=~/\n/s) {
my @stdout_contents=split "\n",$stdout;
my $exit_code=pop(@stdout_contents);
$exit_code=pop(@stdout_contents) if $exit_code=~/^\s*$/s;
if (!defined $exit_code || $exit_code!~/^\d+$/s) {
if ($exit_code=~/^(.*)(0|1|2|126|127|130|137|255)\s*$/s) {
$stdout_contents[$#stdout_contents]=$1;$exitcode=$2;
}
} else {
$exitcode=$exit_code;
}
$stdout=join "\n", @stdout_contents;
} elsif ($stdout=~/\d+$/s) {
if ($stdout=~/^(.*)(0|1|2|126|127|130|137|255)$/s) {
$stdout=$1;$exitcode=$2;
}
}
if ($wantarray) {
$stderr=~s/_funkyPrompt_//gs if $stderr &&
-1<index $stderr,'_funkyPrompt_';
return $stdout,$stderr,$exitcode;
} else { return $stdout }
}
}
sub cmd_raw
{
my $self=$_[0];
my $cmd=$_[1];
my $display=(grep { /__display__/ } @_)?1:0;
$self->{_cmd_handle}->print($cmd);
my $prompt=substr($self->{_cmd_handle}->prompt(),1,-1);
my $alloutput='';
while (1) {
my $output.=Net::FullAuto::FA_Core::fetch($self);
$alloutput.=$output;
last if $output=~/$prompt/;
print $output if $display;
}
return $alloutput;
}
sub display
{
#print "DISPLAY_CALLER=",caller,"\n";sleep 1;
my $line=$_[0];
return '' if -1<index $line,'[sudo]';
my $cmd_prompt=$_[1];
my $save=$_[2];
my $cmd=$_[3]||'';
$line=~s/^stdout: //mg;
if ($line=~/^t?d?o?u?t?:? .*$/s) {
if ($line=~/^.*\nst?d?o?u?t?:?\s*$/s) {
$save.=$line;
return $save;
}
$line=$save.$line;
$line=~s/^stdout: //mg;
print $line;
return '';
} elsif ($line=~/^.*\nst?d?o?u?t?:?\s*$/s) {
$save.=$line;
return $save;
} elsif (length $line<length $cmd_prompt) {
if (-1<index $cmd_prompt,substr($line,(rindex $line,$cmd_prompt))) {
$save.=$line;
return $save;
} else {
$line=~s/\s*\d\s*$//s;
print $line;
return '';
}
} elsif ($line=~s/\n*$cmd_prompt//gs) {
$line=~s/\s+\d\s*$//s;
print $line."\n" unless $line=~/^\d$/;
return '';
} elsif (-1<index $cmd_prompt,$line) {
substr($line,(rindex $line,$cmd_prompt))=0;
$save.=$line;
return $save;
} elsif ($cmd && (-1<index $cmd,'wget')
&& (-1<index $line,'K .')) {
$line=~s/stdout: //g;
print $line;
return '';
} else {
print $line;
return '';
}
}
sub login_retry
{
my @topcaller=caller;
print "\nINFO: Rem_Command::login_retry() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nRem_Command::login_retry() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];my $_connect=$_[1];
my $cmd_type=$_[2];my $error=$_[3];
my $sid='';my $hostlabel='';
if ($self eq $localhost->{_cmd_handle}) {
$hostlabel=$localhost->{_hostlabel}->[0];
print "HOW BOUTTTGGGGG=$hostlabel\n";
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,
$localhost->{_connect});
$sid=($su_id)?$su_id:$login_id;
} else {
LR: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $slid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$slid}}) {
if ($self eq ${$Net::FullAuto::FA_Core::Processes{$hlabel}{$slid}{$type}}[0]) {
$hostlabel=$hlabel;$sid=$slid;
last LR;
}
}
}
}
}
#print "ONEEE=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"},"\n";
#print "TWOOO=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"}->{_work_dirs},"\n";
#print "LOGINRETRYHOSTLABEL=$hostlabel<== and SID=$sid<== and CWD=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"}->{_work_dirs}->{_cwd},"\n";
#print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
my $new_handle='';my ($stdout,$stderr)=('','');
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel);
print $Net::FullAuto::FA_Core::LOG "WHAT IS THE ERROR=$error\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ((-1<index $error,'filehandle isn') ||
(-1<index $error,'read error') ||
(-1<index $error,'Connection closed') ||
!defined fileno $self) {
print $Net::FullAuto::FA_Core::LOG "WE ARE GETTING NEW HANDLE\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
my $handleid="$self";
$self->autoflush(1);
$self->close;
my $kill_arg=($^O eq 'cygwin')?'f':9;
KFH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($handleid eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
print "THISKILL2=${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[2]\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[2],$kill_arg) if
&Net::FullAuto::FA_Core::testpid(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[2]);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[1],$kill_arg) if
&Net::FullAuto::FA_Core::testpid(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[1]);
print "THISKILL1=${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[1]\n";
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
last KFH;
}
}
}
}
($new_handle,$stderr)=&Net::FullAuto::FA_Core::connect_cmdX($hostlabel,$timeout);
print $Net::FullAuto::FA_Core::LOG "NEW HANDLE=$new_handle and STDERR=$stderr\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::LOG,'*';
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
} $self->close;
RL: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($self eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};
last RL;
}
}
}
}
#if (-1<index $new_handle->{_cmd_handle},'HASH') {
# return $new_handle->{_cmd_handle}->{_cmd_handle},'';
#} else { return $new_handle->{_cmd_handle},'' }
return $new_handle->{_cmd_handle},'';
} elsif ($^O ne 'cygwin' && $su_id) {
$self->print;
my $id='';
($id,$stderr)=&Net::FullAuto::FA_Core::unix_id($self,$su_id,
$hostlabel,$error);
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
print "GOT NEW UNIX ID=$id and STDERR=$stderr and SU_ID=$su_id\n";
return '',$error if $stderr;
if ($id eq $su_id) {
if (wantarray) { return '',$error }
else { &Net::FullAuto::FA_Core::handle_error($error,'-3') }
} else {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my ($ignore,$su_err)=
&Net::FullAuto::FA_Core::su($self,$hostlabel,$login_id,
$su_id,$hostname,$ip,$use,$uname,$_connect,$cmd_type,
[],$error);
print "SU_ERR=$su_err\n" if $su_err;
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;
return $self,'';
}
} else { return $self,$error }
}
sub cwd
{
my @topcaller=caller;
print "\nINFO: Rem_Command::cwd() (((((((CALLER))))))):\n ",(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "\nRem_Command::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
return &File_Transfer::cwd(@_);
}
package Bad_Handle;
sub new {
my @topcaller=caller;
print "\nINFO: Bad_Handle::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $class = ref($_[0]) || $_[0];
my $hostlabel=$_[1];
my $stderr=$_[2];
my $self = { };
my $_connect='';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$uname,
$ping,$password,$proxy,$identityfile,$spawn,
$local_pw)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my $host=($use eq 'ip') ? $ip : $hostname;
$self->{_hostlabel}=[ $hostlabel,'' ];
$self->{_hostname}=$hostname;
$self->{_ip}=$ip;
$self->{_uname}=$uname;
$self->{_luname}=$^O;
$self->{_cmd_handle}='';
$self->{_cmd_type}='';
$self->{_ftp_type}='';
$self->{_stderr}=$stderr;
$self->{_ping}=$ping;
$self->{_proxy}=$proxy;
$self->{_identityfile}=
$identityfile;
bless($self,$class);
if (wantarray) {
return $self,'';
} else {
return $self;
}
}
sub close {
return 0,'';
}
sub cmd
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub cwd
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub repl
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::repl() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub select_dir
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::select_dir() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::select_dir() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub get_vlabel
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::get_vlabel() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::get_vlabel() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub ftp
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::ftp() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::ftp() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub get
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::get() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::get() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub put
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::put() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::put() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub lcd
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::lcd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::lcd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub ls
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::ls() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG
"\nBad_Handle::ls() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
package Net::FullAuto::MemoryHandle;
use strict;
sub TIEHANDLE {
my $class = shift;
bless [], $class;
}
sub PRINT {
my $self = shift;
push @$self, join '', @_;
}
sub PRINTF {
my $self = shift;
my $fmt = shift;
push @$self, sprintf $fmt, @_;
}
sub READLINE {
my $self = shift;
shift @$self;
}
package Net::FullAuto::FA_DB;
use strict;
use BerkeleyDB;
sub new
{
my $class=shift;
my $self={};
$self->{_dbfile}=shift;
$self->{_dbfile}=~s/\.db$//;
$self->{_host_queried}={};
$self->{_line_queried}={};
bless($self,$class);
}
sub add
{
print "ADDCALLER=",caller,"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "ADDCALLER=".(caller)."\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];
my $tie_err="can't open tie to $self->{_dbfile}.db";
my $hostlabel=$_[1];
my $line=$_[2];
if (!$line) {
if (wantarray) {
return '','ERROR - no entry specified';
} else {
&Net::FullAuto::FA_Core::handle_error(
"FullAutoDB: ERROR - no entry specified\n");
}
}
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;
$line=~s/^.*\s+($rx1|$rx2)$/$1/;
$line=~/^(\d+)\s+(\w\w\w\s+\d+\s+\S+).*$/;
my $size=$1;my $timestamp=$2;
my $mt='';my $hr=0;my $dy=0;my $mn=0;my $fileyr=0;
eval {
($mn,$dy,$mt)=split /\s+/, $timestamp;
if (-1<index $mt,':') {
($hr,$mt)=split ':', $mt;
$fileyr=(localtime)[5];
} else {
$fileyr=$mt;$mt=0;
}
$timestamp=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$Net::FullAuto::FA_Core::month{$mn}-1,$fileyr);
};
if ($@) {
&Net::FullAuto::FA_Core::handle_error(
"$@ - LSLINE=$line<- AND TIMESTAMP=$timestamp<- AND MN=$mn<-");
}
my $ipc_key="$timestamp$size";
&Net::FullAuto::FA_Core::release_fa_lock($ipc_key);
$line="${hostlabel}|%|$line";
$self->{_host_queried}->{"$hostlabel"}='-';
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Custom');
my $status=$bdb->db_put($line,time);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
$self->{_line_queried}->{$line}='-';
return 1,'';
}
sub query
{
my @topcaller=caller;
print "FA_DB::query() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "FA_DB::query() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $self=$_[0];
my $tie_err="can't open tie to $self->{_dbfile}.db";
my $hostlabel=$_[1];
my $line=$_[2];
if (!$line) {
if (wantarray) {
return '','ERROR - no query specified';
} else {
&Net::FullAuto::FA_Core::handle_error(
"FullAutoDB: ERROR - no query specified\n");
}
}
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
print "LINE TO STRIP TIMEINFO=$line\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "LINE TO STRIP TIMEINFO=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;
$line=~s/^.*\s+($rx1|$rx2)$/$1/;
$line=~/^(\d+)\s+([JFMASOND]\w\w\s+\d+\s+\S+)\s+(.*)$/;
my $size=$1;my $timestamp=$2;my $filename=$3;
my $mt='';my $hr=0;my $dy=0;my $mn=0;my $fileyr=0;
($mn,$dy,$mt)=split /\s+/, $timestamp;
if (-1<index $mt,':') {
($hr,$mt)=split ':', $mt;
$fileyr=(localtime)[5];
} else {
$fileyr=$mt;$mt=0;
}
print $Net::FullAuto::FA_Core::LOG
"TIMEINFO=> MT=$mt HR=$hr DYX=$dy MN=$mn FY=$fileyr\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
$timestamp=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$Net::FullAuto::FA_Core::month{$mn}-1,$fileyr);
my $ipc_key="$timestamp$size";
$line="${hostlabel}|%|$line";
$self->{_host_queried}->{$hostlabel}='-';
print "STARTING TIE\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "STARTING TIE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Custom');
my $result=0;
my $dbcopy='';my $status='';
# print the contents of the file
my ($k, $v) = ("", "") ;
my $cursor = $bdb->db_cursor() ;
my %dbcopy=();
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
$dbcopy{$k}=$v;
}
undef $cursor ;
if (exists $dbcopy{$line}) {
$self->{_line_queried}->{$line}='-';
$result='File has Already been Transferred';
} elsif (&Net::FullAuto::FA_Core::test_semaphore($ipc_key)) {
${$self->{_line_queried}}{$line}='-';
$result='Another Process is Transferring File';
} elsif (!$hr && testtime(\%dbcopy,$filename,$size,
$mn,$dy,$rx1,$rx2,$hostlabel)) {
${$self->{_line_queried}}{$line}='-';
$status=$bdb->db_put($line,time);
$result='File has Already been Transferred';
} elsif (!$Net::FullAuto::FA_Core::cron) {
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
if (time-$timestamp<600 && $timestamp<time) {
${$self->{_line_queried}}{$line}='-';
return 'File Less then 10 Minutes Old','';
}
my $acc='';my $ln='';
($acc,$ln)=split /\|\%\|/, $line;
$ln=~tr/ //s;
my $banner="\n The $acc Account File :\n\n $ln\n\n"
." Is Ready to Transfer\n\n Choose One :";
my @output=("Do NOT Transfer NOW","Do NOT Transfer EVER",
"TRANSFER Now");
my $output=&Menus::pick(\@output,$banner,7);
if ($output eq 'Do NOT Transfer NOW') {
return "User Declines to Transfer File Now",'';
} elsif ($output eq ']quit[') {
&Net::FullAuto::FA_Core::cleanup()
} elsif ($output eq 'Do NOT Transfer EVER') {
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Custom');
my $status=$bdb->db_put($line,time);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
${$self->{_line_queried}}{$line}='-';
return 'User Declines to EVER Transfer File','';
} else {
&Net::FullAuto::FA_Core::acquire_fa_lock($ipc_key);
$self->{_line_queried}->{$line}='-';
if ($Net::FullAuto::FA_Core::log) {
print $Net::FullAuto::FA_Core::LOG "FA_DB::query() QUERYLINE=",
"$line\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $Net::FullAuto::FA_Core::LOG "FA_DB::query() ALL_LINES=",
(join "\n",sort keys %dbcopy),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
return 0,'';
}
} else {
if (time-$timestamp<600) {
$self->{_line_queried}->{$line}='-';
$result='File Less then 10 Minutes Old';
} else {
$self->{_line_queried}->{$line}='-';
&Net::FullAuto::FA_Core::acquire_fa_lock($ipc_key);
if ($Net::FullAuto::FA_Core::log) {
print $Net::FullAuto::FA_Core::LOG "FA_DB::query() QUERYLINE=",
"$line\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
print $Net::FullAuto::FA_Core::LOG "FA_DB::query() ALL_LINES=",
(join "\n",sort keys %dbcopy),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
}
}
}
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
return $result,'';
}
sub testtime
{
my @topcaller=caller;
print "FA_DB::testtime() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::LOG "FA_DB::testtime() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::LOG,'*';
my $dbcopy=$_[0];
my $filename=$_[1];
my $size=$_[2];
my $mn=$_[3];my $dy=$_[4];
my $rx1=$_[5];my $rx2=$_[6];
my $hostlabel=$_[7];
foreach my $dbline (keys %{$dbcopy}) {
my $dbhostlabel='';
($dbhostlabel,$dbline)=split /\|\%\|/,$dbline;
next if $dbhostlabel ne $hostlabel;
$dbline=~s/^.*\s+($rx1|$rx2)$/$1/;
$dbline=~/^(\d+)\s+([JFMASOND]\w\w\s+\d+\s+\S+)\s+(.*)$/;
my $dbsize=$1;my $dbtimestamp=$2;my $dbfilename=$3;
my $dbmt='';my $dbdy=0;my $dbmn=0;
($dbmn,$dbdy,$dbmt)=split /\s+/, $dbtimestamp;
next if -1==index $dbmt,':';
print $Net::FullAuto::FA_Core::LOG "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::LOG,'*';
if ($filename eq $dbfilename && $size eq $dbsize
&& $mn eq $dbmn && $dy eq $dbdy) {
return 1;
}
} return 0;
}
sub mod
{
my $self=shift;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Custom');
my $banner="\n Please Pick a SkipDB Entry to Delete :";
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
my @output=();
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
push @output, $k;
}
undef $cursor;
my $output=&Menus::pick(\@output,$banner,7);
my $status=$bdb->db_del($output);
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
sub close
{
my @caller=caller;
print "CLOSE_Caller=",(join ' ',@caller),"\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
my $self=shift;
my ($dbenv,$bdb)=
Net::FullAuto::FA_Core::connect_berkeleydb('Custom');
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
my $hostlabel=substr($k,0,(index $k,'|%|'));
if (exists ${$self->{_host_queried}}{$hostlabel}
&& !exists ${$self->{_line_queried}}{$k}) {
my $status=$bdb->db_del($k);
}
}
$cursor->c_close();
undef $cursor;
$bdb->db_close();
undef $bdb;
$dbenv->close();
undef $dbenv;
}
package Net::FullAuto::Getline;
# file: IO/Getline.pm
# Figure 13.2: The Getline module
# line-oriented reading from sockets/handles with access to
# internal buffer.
use strict;
use Carp 'croak';
use IO::Handle;
1