package Net::FullAuto::FA_Core;

### OPEN SOURCE LICENSE - GNU AFFERO PUBLIC LICENSE Version 3.0 #######
#
#    Net::FullAuto - Distributed Workload Automation Software
#    Copyright © 2000-2021  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 -
#
## Setup Windows Scheduler for FullAuto:
#
#  cmd /c "c:\cygwin64\bin\bash -lc 
#         '/usr/local/bin/fullauto -gc custom_code --log --authorize_connect'"
#  Place above command in shell file custom_code.bat
#  Put EXIT after command in custom_code.bat
#  | General | tab
#  Inidicate a User Account to use with Task Scheduler
#  Be sure to select 'Run whether user is logged on or not
#  Check the box 'Do not store password ...'
#  Check with highest privileges
#  | Triggers | tab
#  Begin the task: On a schedule
#  One time
#  Check the box 'Repeat task every: time  for a duration of  indefinitely'
#  Check the box 'Stop task if it runs longer than xx minutes'
#  Check the box 'Enabled'
#  | Actions | tab
#  Action: Start a program
#  Program/script:  c:\Windows\System32\cmd.exe
#  Add arguments:   /c start "" "c:\cygwin64\home\User\custom_code.bat"
#  
## 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
#
## Exchange Colors in Gimp
#
#  colors->map->color-exchange
#
## Check Domain Names using netcat
#
#  echo fullauto.com | nc whois.tucows.com 43
#
## Backup to Google Drive
#
#  https://www.experts-exchange.com/articles/29279/Backup-Linux-Servers-to-Google-Drive.html
#
#  wget -O drive https://drive.google.com/uc?id=0B3X9GlR6EmbnMHBMVWtKaEZXdDg
#  mv drive /usr/sbin/drive
#  chmod 755 /usr/sbin/drive
#  drive
#
#  BOOTDRIVE="$(fdisk -l | grep '^/dev/[a-z]*[0-9]' |
#     awk '$2 == "*"' | cut -d ' ' -f 1)"  # or awk 'NR==2'
#  sudo dd conv=sparse if=${BOOTDRIVE} | gzip -c --fast |
#     drive upload --stdin --title bootdrive.gz
#
## *************************************************************

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;
   }

   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;
      }
   }
   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 die
                  $username connect_ftp $cron
                  connect_telnet connect_sftp log
                  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 $OUTPUT
                  get_amazon_external_ip $random
                  fa_welcome get_isets cmd_raw
                  connect_berkeleydb $dashboard
                  clean_filehandle);

{
   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 Proc::ProcessTable;
   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]||'';
      my @topcaller=caller;
      print "\nINFO: main::gbp() (((((((CALLER))))))):\n       ",
         (join ' ',@topcaller)," and CMD=$cmd\n\n"
         if !$Net::FullAuto::FA_Core::cron &&
         $Net::FullAuto::FA_Core::debug;
      print $Net::FullAuto::FA_Core::LOG
         "\nmain::gbp() (((((((CALLER))))))):\n       ",
         (join ' ',@topcaller)," and CMD=$cmd\n\n"
         if $Net::FullAuto::FA_Core::log &&
         -1<index $Net::FullAuto::FA_Core::LOG,'*';
      $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='';
         $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}='';
         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");
                  if (-1<index $stdout,'FOUND') {
                     $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
                        "/usr/bin/";
                     return "/usr/bin/";
                  }
                  my $w='which';
                  if (exists
                        $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$w}) {
                     my $b=$Net::FullAuto::FA_Core::cmdinfo->{$object}->{$w};
                     ($stdout,$stderr)=$handle->cmd("${b}which $cmd");
                     my $found='';
                     ($found,$stderr)=$handle->cmd(
                        "if [ -f $stdout ];then echo \"FOUND\";fi");
                     if (-1<index $found,'FOUND') {
                        $found=~s/^(.*\/).*$/$1/;
                        $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
                           $found;
                        return $found;
                     } else { return '' }
                  } else {
                     ($stdout,$stderr)=$handle->cmd(
                        "if [ -f /bin/$w ];then echo \"FOUND\";fi");
                     if (-1<index $stdout,'FOUND') {
                        $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$w}=
                           "/bin/";
                        ($stdout,$stderr)=$handle->cmd("/bin/$w $cmd");
                        chomp($stdout);
                        $stdout=~s/^(.*\/).*$/$1/;
                        ($stdout,$stderr)=$handle->cmd(
                           "if [ -f $stdout ];then echo \"FOUND\";fi");
                        if (-1<index $stdout,'FOUND') {
                           $stdout=~s/^(.*\/).*$/$1/;
                           $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
                              $stdout;
                           return $stdout;
                        } else { return '' }
                     }
                     ($stdout,$stderr)=$handle->cmd(
                        "if [ -f /usr/bin/$w ];then echo \"FOUND\";fi");
                     if (-1<index $stdout,'FOUND') {
                        $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$w}=
                           "/usr/bin/";
                        ($stdout,$stderr)=$handle->cmd("/usr/bin/$w $cmd");
                        chomp($stdout);
                        $stdout=~s/^(.*\/).*$/$1/;
                        ($stdout,$stderr)=$handle->cmd(
                           "if [ -f $stdout ];then echo \"FOUND\";fi");
                        if (-1<index $stdout,'FOUND') {
                           $stdout=~s/^(.*\/).*$/$1/;
                           $Net::FullAuto::FA_Core::cmdinfo->{$object}->{$cmd}=
                              $stdout;
                           return $stdout;
                        } else { return '' }
                     } else { return '' }
                  }
               }
            } else {
               unless (exists $handle->{_shell}) {
                  bless($handle);
                  ($stdout,$stderr)=$handle->cmd('env');
                  if ($stdout=~/^SHELL=(.*)$/m) {
                     my $shell=$1;chomp $shell;
                     $handle->{_shell}=$shell;
                  }
               }
               $handle->{_shell}||='';
               if ((-1<index $handle->{_shell}, 'bash') ||
                     (-1<index $handle->{_shell}, 'ksh')) {
                  ($stdout,$stderr)=$handle->cmd(
                     "if [ -f /bin/$cmd ];then echo \"FOUND\";fi");
                  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`;
            chomp($found);
            $found=~s/^(.*\/).*$/$1/;
            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};
      }
   };

   my $termwidth='';my $termheight='';
   my $stdout_capture='';my $stderr_capture='';
   if (!$Net::FullAuto::FA_Core::cron ||
         $Net::FullAuto::FA_Core::debug) {
      ($termwidth,$termheight,
            $stdout_capture,$stderr_capture)=eval {
         no strict 'subs';
         my ($termwidth,$termheight)=('','');
         my ($stdout_capture,$stderr_capture)=
            Capture::Tiny::capture {
               ($termwidth, $termheight) =
                  Term::ReadKey::GetTerminalSize();
               $termwidth||='';$termheight||='';
         }; return $termwidth,$termheight,
               $stdout_capture,$stderr_capture;
      };
      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 => 0,
                  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,$dashboard,
     $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 $OUTPUT='';
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 die {
   my @topcaller=caller;
   print "\nINFO: main::die() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if !$Net::FullAuto::FA_Core::cron &&
      $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG
      "\nmain::die() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   CORE::die($@);
}

sub get {

   my @topcaller=caller;
   print "\nINFO: main::get() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if !$Net::FullAuto::FA_Core::cron &&
      $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG
      "\nmain::get() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   return File_Transfer::get(@_);

}

sub put {

   my @topcaller=caller;
   print "\nINFO: main::put() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if !$Net::FullAuto::FA_Core::cron &&
      $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG
      "\nmain::put() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   return File_Transfer::put(@_);

}

sub lcd {

   my @topcaller=caller;
   print "\nINFO: main::lcd() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if !$Net::FullAuto::FA_Core::cron &&
      $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG
      "\nmain::lcd() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   return File_Transfer::lcd(@_);

}

sub ftpcmd {

   my @topcaller=caller;
   print "\nINFO: main::ftpcmd() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if !$Net::FullAuto::FA_Core::cron &&
      $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG
      "\nmain::ftpcmd() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   return File_Transfer::ftpcmd(@_);

}

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') ||
            (-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();
                        &Net::FullAuto::FA_Core::handle_error("$@       $!")
                     }
                  }
               }
               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();
                        &Net::FullAuto::FA_Core::handle_error("$@       $!")
                     }
                  }

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) {
#print "GOING TO INT NINEZZZ\n";
                           #$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 {
#print "GOING TO INT ONEZZZ\n";
                                 #$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})) {
#print "GOING TO INT TWOZZZ\n";
         #$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 $proc_table=Proc::ProcessTable->new;
   foreach (@{$proc_table->table()}) {
      kill 15, $_->pid if ($_->ppid == $$);
   }
   if ((!$Net::FullAuto::FA_Core::cron
         || $Net::FullAuto::FA_Core::debug)
         && !$Net::FullAuto::FA_Core::quiet) {
      print "\n";
   } ReadMode 0;
   $OUTPUT||='';
   CORE::close($OUTPUT) if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   $OUTPUT='';
   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='';
   my $outd=$Hosts{"__Master_${$}__"}{'LogFile'}||'';
   $outd=~s/^(.*)\/.*$/$1/;
   $Hosts{"__Master_${$}__"}{'LogFile'}||='';
   print "\n  LOGFILE ==> \"",
      $Hosts{"__Master_${$}__"}{'LogFile'},"\"\n"
      if $Net::FullAuto::FA_Core::log &&
      !($Net::FullAuto::FA_Core::quiet ||
      $Net::FullAuto::FA_Core::cron);
   print "  OUTPUT  ==> \"",
      $outd."/OUTPUT.txt","\"\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'};
   }
   my $fa_conf='';
   if (defined $Term::Menus::fa_conf) {
      $fa_conf=$Term::Menus::fa_conf;
      if (ref $fa_conf eq 'ARRAY' && 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';
         };
      }
   }
   if ($fa_conf::save_fa_logs_dot_zip_in_current_directory) {
      if (my $zip=$Net::FullAuto::FA_Core::gbp->('zip')) {
         `cp $Hosts{"__Master_${$}__"}{'LogFile'} .`;
         `cp $outd/OUTPUT.txt .`;
         my $logname=$Hosts{"__Master_${$}__"}{'LogFile'};
         $logname=~s/^.*\/(.*)$/$1/;
         unlink 'fa_logs.zip';
         `$zip/zip fa_logs.zip OUTPUT.txt $logname`;
         unlink "OUTPUT.txt";
         unlink $logname;
      }
   }
   if ($param_two eq 'ALRM') {
      print "\nINFO: Going to pkill"
         if !$Net::FullAuto::FA_Core::cron &&
         $Net::FullAuto::FA_Core::debug;
      print $Net::FullAuto::FA_Core::LOG
         "\nINFO: Going to pkill"
         if $Net::FullAuto::FA_Core::log &&
         -1<index $Net::FullAuto::FA_Core::LOG,'*';
      my $pkill=$Net::FullAuto::FA_Core::gbp->('pkill');
      exec "$pkill/pkill fullauto.pl";
   }
   return 1 if $param_one eq '__return__';
   exit 1 if $param_one;
   exit 0;

};

# Handle INT SIGNAL interruption
$SIG{ INT } = sub{
                    print "\n\nSIG INT CALLER=".caller."\n";
      my $trace = Devel::StackTrace->new();
      print "\nINFO: SIG INT (((((((CALLER))))))):\n       ",
      $trace->as_string(),"\n\n";

                    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
{

   my $path=
      substr($INC{'Net/FullAuto.pm'},0,
      (rindex $INC{'Net/FullAuto.pm'},'Net'));
   eval {
      require "${path}Net/FullAuto/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 @topcaller=caller;
   print "\nINFO: main::fetch() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if !$Net::FullAuto::FA_Core::cron &&
      $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG
      "\nINFO: main::fetch() (((((((CALLER))))))):\n       ",
      (join ' ',@topcaller),"\n\n"
      if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   my $self=$_[0];my $output='';my $select_timeout=2;my $ready='';
   my $save=$_[1]||'';
   my $display=(grep { /__display__/ } @_)?1:0;
   if (select $ready=${${*{$self->{_cmd_handle}}}{'net_telnet'}}{'fdmask'},
          '', '', $select_timeout) {
      alarm($select_timeout+10);
      eval {
         local $SIG{ALRM} =
            sub { &Net::FullAuto::FA_Core::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();
      }
      my $prompt=$self->prompt();
      $save=&Rem_Command::display($output,$prompt,$save)
         if $display;
      print $Net::FullAuto::FA_Core::LOG $output
         if $Net::FullAuto::FA_Core::log &&
         -1<index $Net::FullAuto::FA_Core::LOG,'*';
      return $output unless wantarray;
      return $output,'' unless $save;
      return $output,$save;
   } return '' unless wantarray;
   return '','';

}

sub cmd_raw
{

   my $self=$_[0];
   my $cmd=$_[1];
   my $display=(grep { /__display__/ } @_)?'__display__':'';
   $self->print($cmd);
   my $prompt=$self->prompt();
   my $alloutput='';
   my $save='';
   while (1) {
      my $output='';
      ($output,$save)=fetch($self,$save);
      $alloutput.=$output;
      last if $output=~/$prompt/;
   }
   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-2021, 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) ||
         Net::FullAuto::FA_Core::handle_error("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) ||
               &Net::FullAuto::FA_Core::handle_error("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") ||
                        &Net::FullAuto::FA_Core::handle_error(
                        "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") ||
                              &Net::FullAuto::FA_Core::handle_error(
                              "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|\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 Net::FullAuto::FA_Core::handle_error($!);
         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 {

   my $path=
      substr($INC{'Net/FullAuto.pm'},0,
      (rindex $INC{'Net/FullAuto.pm'},'Net'));
   $path.='Net/FullAuto/';
   $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 {
   my $path=
      substr($INC{'Net/FullAuto.pm'},0,
      (rindex $INC{'Net/FullAuto.pm'},'Net'));
   $path.='Net/FullAuto/';
   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");
      &Net::FullAuto::FA_Core::handle_error($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 ..");
         &Net::FullAuto::FA_Core::handle_error($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 { &Net::FullAuto::FA_Core::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 { &Net::FullAuto::FA_Core::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 {
                                        &Net::FullAuto::FA_Core::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=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;
   }

   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||$ENV{'HOME'}||'';
            $home_dir.='/';
            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 {
                                     &Net::FullAuto::FA_Core::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 {
                                     &Net::FullAuto::FA_Core::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) {
                  &Net::FullAuto::FA_Core::handle_error($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/) {
         my $socket = IO::Socket::INET->new(
            Proto       => 'udp',
            PeerAddr    => '198.41.0.4', # a.root-servers.net
            PeerPort    => '53', # DNS
         );
         my $ip=$socket->sockhost ||
            &handle_error(
            "Couldn't Resolve Local Hostname $Local_HostName : ");
         $same_host_as_Master{$ip}='-';
         $Local_IP_Address->{$ip}='-';
      } else {
         my $ip='127.0.0.1';
         $same_host_as_Master{$ip}='-';
         $Local_IP_Address->{$ip}='-';
         $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_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')) {
      my $connect_caller=$caller;
      $_connect=(split '::', $caller)[2];
      ($caller,$sub)=split '::', (caller(2))[3];
      $caller.='.pm';
      if (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'};
         }
         $_[0]->{'label'}||='';
         $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 $noretry='',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 (lc($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};
         $Hosts{$hostlabel}{'IdentityFile'}=
            $Hosts{$hostlabel}{$key};
      } elsif (lc($key) eq 'noretry') {
         $noretry=$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,$noretry);

}

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 (exists $ENV{'SHELL'} && -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
{

   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,$noretry)
       =&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
       $hostlabel);
   my $host='';my $stdout='';my $stderr='';
   if (exists $Hosts{$hostlabel}{'cyberark'}) {
      my $capath=$Net::FullAuto::FA_Core::gbp->('clipasswordsdk');
      $capath||='/opt/CARKaim/sdk/';
      my $app_id=$Hosts{$hostlabel}{'ca_appid'}||'';
      my $ca_das=$Hosts{$hostlabel}{'ca_das'}||'';
      my $ca_safe=$Hosts{$hostlabel}{'ca_safe'}||'';
      $ca_das=";DualAccountStatus=$ca_das" if $ca_das;
      $ca_safe="Safe=$ca_safe;" if $ca_safe;
      my $ca_host=$Hosts{$hostlabel}{'ca_host'}||'localhost';
      my $ca_user=$Hosts{$hostlabel}{'loginid'}||$username;
      my $cmd="${capath}clipasswordsdk GetPassword -p "
             ."AppDescs.AppID=$app_id -p Query=\"${ca_safe}Address="
             ."$hostname;Username=$ca_user"
             ."$ca_das\" -p RequiredProps=* -o Password";
      unless ($ca_das) {
         $cmd="${capath}clipasswordsdk GetPassword -p "
             ."AppDescs.AppID=$app_id -p Query=\"${ca_safe}Address="
             ."$hostname;Username=$ca_user\" "
             ."-p RequiredProps=* -o Password";
      }
      if ($ca_host=~/localhost/i or !$ca_host) {
         unless (keys %{$localhost}) {
            $localhost=connect_shell();
         }
         ($stdout,$stderr)=$localhost->cmd($cmd);
      } else {
         # CODE TO ACCESS OTHER SERVERS FOR CYBERARK
      }
      return $stdout;
   }
   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";
      $passlabel='localhost';
   }
   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);
      my $test_string=Data::Dump::Streamer::Dump($href)->Out();
      if (-1<index $test_string,'{}') {
         $href={};
      } else {
         $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"}
            and $passlabel eq 'localhost') {
         $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 { &Net::FullAuto::FA_Core::die("alarm\n") }; 
               # \n required
            local $SIG{INT}  = sub { &Net::FullAuto::FA_Core::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);
      my $test_string=Data::Dump::Streamer::Dump($href)->Out();
      if (-1<index $test_string,'{}') {
         $href={};
      } else {
         $href=~s/\$HASH\d*\s*=\s*//s;
         $href=eval $href;
      }
      $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}}) {
               my $f='';
               if (ref $attach eq 'HASH') {
                  if (exists $attach->{Path}) {
                     $f=$attach->{Path};
                     $f=~tr/\0-\11\13-\37\177-\377//d;
                     unless (-f $f) {
                        Net::FullAuto::FA_Core::handle_error(
                           "Cannot locate attachment file: $attach->{Path}");
                     }
                  } else {
                     Net::FullAuto::FA_Core::handle_error(
                        "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},

                  );
               } elsif (-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 {
                  &Net::FullAuto::FA_Core::handle_error(
                     "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 {
               Net::FullAuto::FA_Core::handle_error($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-2021  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);
         &Net::FullAuto::FA_Core::handle_error($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);
         &Net::FullAuto::FA_Core::handle_error($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);
         &Net::FullAuto::FA_Core::handle_error($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);
      &Net::FullAuto::FA_Core::handle_error($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);
      &Net::FullAuto::FA_Core::handle_error($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);
   &Net::FullAuto::FA_Core::handle_error($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);
                  &Net::FullAuto::FA_Core::handle_error($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);
                  &Net::FullAuto::FA_Core::handle_error($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);
                  &Net::FullAuto::FA_Core::handle_error($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);
               &Net::FullAuto::FA_Core::handle_error($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);
                  &Net::FullAuto::FA_Core::handle_error($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 { Net::FullAuto::FA_Core::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 { &Net::FullAuto::FA_Core::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 { &Net::FullAuto::FA_Core::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 { &Net::FullAuto::FA_Core::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-2021  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') ||
            (-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=0;
#$Net::FullAuto::FA_Core::log=0;

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 { &Net::FullAuto::FA_Core::die("alarm\n") };
            # \n required
         local $SIG{INT}  =
            sub { &Net::FullAuto::FA_Core::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);
      my $test_string=Data::Dump::Streamer::Dump($href)->Out();
      if (-1<index $test_string,'{}') {
         $href={};
      } else {
         $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 { &Net::FullAuto::FA_Core::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->[1]=$Net::FullAuto::FA_Core::choose_pass_expiration->();
         $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 { &Net::FullAuto::FA_Core::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);
      my $test_string=Data::Dump::Streamer::Dump($href)->Out();
      if (-1<index $test_string,'{}') {
         $href={};
      } else {
         $href=~s/\$HASH\d*\s*=\s*//s;
         $href=eval $href;
      }
      $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";
            $display||='';
            my $connect='$'.$dd.'CONNECT';
            $dirtree->{$display}=
               [$fp,'$'.$dd,$nm,$connect];
         }
      }
   }
   closedir(DIR);
   return $dirtree;
}

sub get_isets
{

   my $path_to_iset=$_[0]||'';
   my $path=
      substr($INC{'Net/FullAuto.pm'},0,
      (rindex $INC{'Net/FullAuto.pm'},'Net'));
   $path.='Net/FullAuto/';
   my $ispath=$path."ISets";
   $ispath.='/' if $path_to_iset &&
            unpack('a1',$path_to_iset) ne '/';
   my $dirtree={};
   unless (-d $ispath.$path_to_iset) {
      if (-e $path_to_iset) {
         my $fp=$path_to_iset;
         if ($path_to_iset=~/is[.]pm$/) {
            my $nm=$path_to_iset;
            $nm=~s/_is[.]pm$//;
            require $path_to_iset;
            $path_to_iset=~s/[.]pm$//;
            $path_to_iset=~s/\//::/g;
            $path_to_iset.='::';
            my $display='$'.$path_to_iset.'DISPLAY';
            eval "\$display=$display";
            $display||='';
            my $connect='$'.$path_to_iset.'CONNECT';
            $dirtree->{$display}=
               [$fp,'$'.$path_to_iset,$nm,$connect];
         }
      }
   } else {
      $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 { &Net::FullAuto::FA_Core::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;
      $OUTPUT=*OUTPUT;
      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 $outd=$Hosts{"__Master_${$}__"}{'LogFile'};
      $outd=~s/^(.*)\/.*$/$1/;
      sysopen($OUTPUT,$outd."/OUTPUT.txt"
                    ,(O_WRONLY|O_CREAT)) # write mode,
                    || &handle_error($!);# create if needed
      unless ($quiet) {
         print "  OUTPUT ==> \"",
            $outd,"/fa_output.txt\"\n";
         $cache->set($cache->{'key'},
            [0,"  OUTPUT ==> \"",
            $outd."/fa_output.txt","\"\n"])
            if $cache;
      }
      $OUTPUT->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 || $fa_conf::save_fa_logs_dot_zip_in_current_directory) {
      $log=1 if !$log and $fa_conf::save_fa_logs_dot_zip_in_current_directory;
      $Net::FullAuto::FA_Core::log=$log
         unless $Net::FullAuto::FA_Core::log;
      $LOG=*LOG;
      $OUTPUT=*OUTPUT;
      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);
      my $outd=$olog;
      $outd=~s/^(.*)\/.*$/$1/;
      unless ($quiet) {
         print "\n  LOGFILE ==> \"$olog\"\n";
         print "  OUTPUT  ==> \"$outd/OUTPUT.txt\"\n";
         $cache->set($cache->{'key'},
            [0,"\n  LOGFILE ==> \"$olog\"\n"])
            if $cache;
         $cache->set($cache->{'key'},
            [0,"  OUTPUT ==> \"$outd/OUTPUT.txt\"\n"])
            if $cache;
      }
      sysopen($OUTPUT,"$outd/OUTPUT.txt",(O_WRONLY|O_CREAT)) # write mode,
                          || &handle_error($!);# create if needed
      $OUTPUT->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";
   } else {
      $LOG='';
      return 0;
   }
   my $mr="__Master_".$$."__";
   unless (exists $Hosts{$mr}) {
      $mr="__Master_".getppid."__";
   }
   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>;
   foreach my $ln (@data) {
      if ($ln=~/^\s*[#]*\s*our\s+[\$]logcount\s*=\s*(\d+)\s*;*\s*$/i) {
         $Hosts{'localhost'}{'LogCount'}=$1;
      }
   }
   $fconf=$Hosts{$mr}{'FA_Core'}.'Custom/'.$username.
             '/Conf/'.$Net::FullAuto::FA_Core::fa_conf;
   @data=();
   open(CH,"+<$fconf") or &handle_error("Cannot open $fconf");
   flock CH, 2;
   @data=<CH>;
   foreach my $ln (@data) {
      if ($ln=~/^\s*[#]*\s*our\s+[\$]logcount\s*=\s*(\d+)\s*;*\s*$/i) {
         $Hosts{'localhost'}{'LogCount'}=$1;
      }
   }
   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||$ENV{'HOME'}||'';
         $home_dir.='/';
         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/) {
      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;
      $bdb = BerkeleyDB::Btree->new(
         -Filename =>
            "${Net::FullAuto::FA_Core::progname}_${kind}_$lc_dbname.db",
         -Flags    => DB_CREATE,
         -Env      => $dbenv
      );
      unless ($BerkeleyDB::Error=~/Successful/) {
         &Net::FullAuto::FA_Core::handle_error("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,
                'dashboard'             => \$dashboard,
                '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];
   }
   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 $socket = IO::Socket::INET->new(
       Proto       => 'udp',
       PeerAddr    => '198.41.0.4', # a.root-servers.net
       PeerPort    => '53', # DNS
   );
   my $ip=$socket->sockhost||'';
   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;

   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 { &Net::FullAuto::FA_Core::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 (-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 if !$amazoncleanup && !$iset_amazon;
                     $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 (!$LOG) {
            Net::FullAuto::FA_Core::log();
         }
         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);
                        &Net::FullAuto::FA_Core::handle_error($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);
                        &Net::FullAuto::FA_Core::handle_error($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);
                        &Net::FullAuto::FA_Core::handle_error($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);
                     &Net::FullAuto::FA_Core::handle_error($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);
                        &Net::FullAuto::FA_Core::handle_error($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);
            my $test_string=Data::Dump::Streamer::Dump($pref)->Out();
            if (-1<index $test_string,'{}') {
               $pref={};
            } else {
               $pref=~s/\$HASH\d*\s*=\s*//s;
               $pref=eval $pref;
            }
            $pref||={};
            my $pla_n=$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}) {
#print "GOING TO INT THREEZZZ\n";
               #$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') {
#print "GOING TO INT FOURZZZ\n";
               #$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 { &Net::FullAuto::FA_Core::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||$ENV{'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);
                     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);
                           &Net::FullAuto::FA_Core::handle_error($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);
                        &Net::FullAuto::FA_Core::handle_error($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||$ENV{'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);
                           &Net::FullAuto::FA_Core::handle_error($stderr);
                        } elsif (-1<index $stderr,'/dev/tty: No') {
                           &release_fa_lock(6543);
                           &Net::FullAuto::FA_Core::handle_error(
                               "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||$ENV{'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) { 
               $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);
                     my $test_string=Data::Dump::Streamer::Dump($href)->Out();
                     if (-1<index $test_string,'{}') {
                        $href={};
                     } else {
                        $href=~s/\$HASH\d*\s*=\s*//s;
                        $href=eval $href;
                     }
                     $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);
                     &Net::FullAuto::FA_Core::handle_error($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);
                     &Net::FullAuto::FA_Core::handle_error($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);
            my $test_string=Data::Dump::Streamer::Dump($lref)->Out();
            if (-1<index $test_string,'{}') {
               $lref={};
            } else {
               $lref=~s/\$HASH\d*\s*=\s*//s;
               $lref=eval $lref;
            }
            $lref||={};
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,'*';
            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);
               my $test_string=Data::Dump::Streamer::Dump($href)->Out();
               if (-1<index $test_string,'{}') {
                  $href={};
               } else {
                  $href=~s/\$HASH\d*\s*=\s*//s;
                  $href=eval $href;
               }
               $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 BEFORE PS CMD OUTPUT:\n       ",
                  "$ps_out\n"
                  if $Net::FullAuto::FA_Core::log &&
                  -1<index $Net::FullAuto::FA_Core::LOG,'*';
               my $proc_table=Proc::ProcessTable->new;
               foreach (@{$proc_table->table()}) {
                  CORE::kill 15, $_->pid if ($_->ppid == $$);
               }
               $ps_out=`${pspath}ps -el`;
               print $Net::FullAuto::FA_Core::LOG
                  "\nHERE IS THE AFTER PS CMD OUTPUT:\n       ",
                  "$ps_out\n"
                  if $Net::FullAuto::FA_Core::log &&
                  -1<index $Net::FullAuto::FA_Core::LOG,'*';
            } 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/) {
               &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,'*';
         &Net::FullAuto::FA_Core::handle_error($die);

      } 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);
      my $test_string=Data::Dump::Streamer::Dump($pref)->Out();
      if (-1<index $test_string,'{}') {
         $pref={};
      } else {
         $pref=~s/\$HASH\d*\s*=\s*//s;
         $pref=eval $pref;
      }
      $pref||={};
      $plan=$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],
         '',$iset_amazon);
   } 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;
                  my $test_string=
                        Data::Dump::Streamer::Dump($default_modules)->Out();
                  if (-1<index $test_string,'{}') {
                     $default_modules={};
                  } else {
                     $default_modules=~s/\$HASH\d*\s*=\s*//s;
                     $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";
                  &Net::FullAuto::FA_Core::handle_error($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 (!map {/^--edi*t* *|^-e[a-z]|^--admin|^-V|^-v|^--VE*R*S*I*O*N*/} @ARGV) {
      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;
            &Net::FullAuto::FA_Core::handle_error(
                "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 (!map {/^--edi*t* *|^-e[a-z]|^--admin|^-V|^-v|^--VE*R*S*I*O*N*/} @ARGV) {
      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;
            &Net::FullAuto::FA_Core::handle_error(
                "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 (!map {/^--edi*t* *|^-e[a-z]|^--admin|^-V|^-v|^--VE*R*S*I*O*N*/} @ARGV) {
      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;
            &Net::FullAuto::FA_Core::handle_error(
                "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 (!map {/^--edi*t* *|^-e[a-z]|^--admin|^-V|^-v|^--VE*R*S*I*O*N*/} @ARGV) {
      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;
            &Net::FullAuto::FA_Core::handle_error(
                "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;
      }
      &Net::FullAuto::FA_Core::handle_error('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) {
         &Net::FullAuto::FA_Core::handle_error(
            "Cannot discover user id at ".__LINE__);
      }
   }
   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 @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
      }
   }
   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") || Net::FullAuto::FA_Core::handle_error(
            "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,$noretry)
       =&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 print
{

   my @topcaller=caller;
   print "main::print() CALLER=",
      (join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG "main::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 "main::prompt() CALLER=",
      (join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG "main::prompt() CALLER=",
      (join ' ',@topcaller),
      "\n" if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   my $self=shift @_;
   if (-1<$#_) {
      return $self->{_cmd_handle}->prompt(@_);
   } return substr($self->{_cmd_handle}->prompt(),1,-1);

}

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}) {
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;
      }
      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 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 $successflag=0;
      if ($bdb) {
         my $status=$bdb->db_get($passlabel,$href);
         $href=~s/\$HASH\d*\s*=\s*//s;
         $href=eval $href;
         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 { &Net::FullAuto::FA_Core::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,$noretry)
          =&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;
      $self->{_noretry}=$noretry;
      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,$noretry)
       =&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_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='';
   my $save='';
   while (1) {
      my $output.=Net::FullAuto::FA_Core::fetch($self);
      $alloutput.=$output;
      last if $output=~/$prompt/;
      #print $output if $display;
      $save=&Rem_Command::display($output,$prompt,$save)
         if $display;
   }
   return $alloutput;

}

sub print
{

   my @topcaller=caller;
   print "File_Transfer::print() CALLER=",
      (join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG "File_Transfer::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 "File_Transfer::prompt() CALLER=",
      (join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
   print $Net::FullAuto::FA_Core::LOG "File_Transfer::prompt() CALLER=",
      (join ' ',@topcaller),
      "\n" if $Net::FullAuto::FA_Core::log &&
      -1<index $Net::FullAuto::FA_Core::LOG,'*';
   my $self=shift @_;
   if (-1<$#_) {
      return $self->{_cmd_handle}->prompt(@_);
   } return substr($self->{_cmd_handle}->prompt(),1,-1);

}

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 $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,$noretry)
       =&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,$noretry)
       =&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'})) {
            if ($hostlabel!~/__Master_${$}__/ && !$identityfile
                  && !(exists $Hosts{$hostlabel}{'cyberark'})) {
               $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};
                              ($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 {
                                 ($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);
                              }
                              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};
                              ($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'}."'".' ';
               }
               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) {
            $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 {
                                    &Net::FullAuto::FA_Core::die("alarm\n")
                                 }; # \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 { 
                                         &Net::FullAuto::FA_Core::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 {
                                 #ZZZ
                                 #$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.
                                 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) {
                  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 "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,'*';

                        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,'*';
               #ZZZ
               #$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)) {
            local $SIG{ALRM} =
               sub {
                  &Net::FullAuto::FA_Core::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 ||
                     $lin=~/ssh_askpass.*No such file or directory/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,'ssh_askpass') &&
                  (-1<index $line,'No such file or directory')) {
               die "can\'t open /dev/tty: No such device or address\n";
            } elsif (-1<index $lin,'Authentication succeeded (publickey)') {
               return $lin,'';
            } elsif (-1<index $lin,'/bin/bash: Operation not permitted') {
               Net::FullAuto::FA_Core::bash_operation_not_permitted(
                  $hostlabel);
            } elsif ($line=~/sftp>\s*$/s) {
               return 'key_authenticated','';
            } elsif ($warning || (-1<index $line,'@@@@@@@@@@') ||
                  (-1<index $line,'No more authentication methods to try')) {
               $warning.=$line;
               $count++ if $line=~/^\s*$/s;
               if ((-1<index $warning,'UNPROTECTED PRIVATE KEY') ||
                     (-1<index $line,'No more authentication methods to try')) {
                  print "\n",$warning;
                  die $warning;
               } elsif ($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 $line,'Permission denied') {
               if (-1<index $line, 'publickey') {
                  chomp $line;
                  die $line;
               }
               die 'Permission denied';
            } 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 { &Net::FullAuto::FA_Core::die("alarm\n") };
                           # \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[: ]+$|passphrase/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,'*';
               $determine_password->($login_Mast_error,$loop_count,
                                     $hostlabel,$password)
                  if $filehandle->{_hostlabel}->[0]=~/__Master_${$}__/;
               $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,'Connection timed')
                  || (-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.*$)
                      |(^ssh:[ ]connect[ ]to.*$)/xm;
               $lin=$1 if $1;$lin=$2 if $2;
               $lin=$3 if $3;$lin=$4 if $4;
               $lin=$5 if $5;$lin=$6 if $6;
               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();
                  }
               } elsif (wantarray) {
#print "WHAT IS ERROR=$@ and CALLER=",caller,"\n";
                  return '',$@;
               }
               print "NO ERROR HANDLER for $@\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,$noretry)
       =&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");
   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 '\\';
   $target_dir=~s/[~]/$self->{_homedir}/;
   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,$noretry)
       =&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 "CWD 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};
            $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)=Rem_Command::cmd(
                  { _cmd_handle=>$self->{_cmd_handle},
                    _host_label=>[ $hostlabel,'' ] },
                    "cd $target_dir");
            $stderr=$output if -1<index $output,"Couldn't can";
         } elsif ((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;
         }
         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') {
            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}->{_pre_mswin}=
               $self->{_work_dirs}->{_cwd_mswin};
            $self->{_work_dirs}->{_cwd_mswin}=$tdir.'\\\\';
         }
      } 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') }
            }
         }
      } 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')
                  }
               }
            }
            if (exists $self->{_cmd_handle} && $self->{_cmd_handle}) { 
               ($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 ':') {
            if (exists $self->{_work_dirs}->{_cwd}) {
               $target_dir=$self->{_work_dirs}->{_cwd} 
                   ="$self->{_work_dirs}->{_cwd}/$target_dir/";
            } elsif (exists $self->{_work_dirs}->{_cwd_mswin}) {
               $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);
            $self->{_work_dirs}->{_pre}=
                $self->{_work_dirs}->{_cwd}=$target_dir.'/' unless $stderr;
            $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')) {
            ($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/( 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,$bnoretry)
       =&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,$dnoretry)
       =&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,$dnoretry)
         =&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}}) {
                                    ($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;
                        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,$dest_fdr);
#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,$dest_fdr);
               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,
       $dest_fdr)=('','','','','','','');
   ($baseFH,$btransfer_dir,$destFH,$shortcut,$cache,$tarlistmpdir,
       $dest_fdr)=@_;
   my ($output,$stdout,$stderr)=('','','');
   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}) {
            ($output,$stderr)=&Rem_Command::ftpcmd($destFH,
                  "lcd \"$baseFH->{_work_dirs}->{_tmp}\"",$cache);
            if (exists $baseFH->{_ftp_handle}) {
               $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');
            $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}";
         }
         ($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) {
            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;
      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");