#!/usr/bin/perl -w
#
# $Id: pica,v 1.20.2.62.2.2 2002/09/02 23:16:13 cvs Exp $
#
# Perl Instaler and Configuration Agent (PICA)
# or
# PICA Is for C{ompetent,ompulsive,razy} Admins
#
#   Copyright (C) 2001,2002  Miguel Armas, Esteban Manchado
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# 
#
# You may need to edit the ``Configuration Variables'' below

=head1 NAME

pica - Copy files and execute commands remotely

=head1 SYNOPSIS

B<pica> (B<-i>|B<-t>|B<-f>|B<-x>) [B<-n>][B<-d>][B<-v>]
B<+F> files B<+H> hosts




=head1 DESCRIPTION

PICA  is  a  program  for system administration. It copies files, after
preprocess them, to remote hosts, and execute commands remotely.

It  has  three  configuration files: F<pica.conf>, F<hosts.conf> and
F<objects.conf>, where information  about  external programs,  the  hosts  to
manage  and the objects defined is given.

For full documentation and examples, please refer  to  the PICA manual,
available in LaTeX and Postscript.




=head1 ACTIONS

=over

=item B<-i>

Installs  (copies)  the  specified object(s) in the specified host(s).

=item B<-t>

Deletes the specified object(s) from the  specified host(s).

=item B<-f>

Calculates  and  prints the differences between the currently installed
version of the object(s) in the specified  hosts(s)  and the version that
should be installed.

=item B<-x>

Executes remotely the specified command(s)  in  the specified host(s).

=back




=head1 OPTIONS

=over

=item B<-d>

Debug mode: simply prints what it's supposed to do, without actually doing it,
and prints lots of debug information.

=item B<-n>

Do  nothing.  Prints commands to execute instead of actually execute them, a
la make.

=item B<-v>

Verbose mode. Prints some more text, but not debug- ging information like
B<-d>.

=back




=head1 PPP (PERL PREPROCESSOR)

Every config file and distribution file is preprocessed by PICA before parsing
or distributing it. The  Perl  Preprocessor  allows  the user to
dynamically build the file by means of conditionals and random Perl code. The
basic syntax is that of the C preprocessor, but adapted to Perl.

In  general, every expression is an arbitrary Perl expression, and besides
internal variables and  functions,  distribution  files  always  have
I<$picahost>  and I<$picaobject> variables available. The special directives
understood  by PPP are:

=over

=item B<#include ">expressionB<">

Includes  a  file, after preprocess it. Searchs for the file in the current
file's directory.

=item B<#include E<lt>>expressionB<E<gt>>

Includes a file, after preprocess it.  Searchs  for the  file in the include
directories (picainclude).

=item B<#if (>expressionB<)>/B<#elsif (>expressionB<)>/B<#else>/B<#fi>

Treats that portion of the file conditionally.

=item B<#perl>/B<#lrep>

Executes the Perl code enclosed and prints  in  the output  file the returned
value. Everything printed in this environment will be printed at
preprocessing time to the screen.

=item B<E<lt>#>/B<#E<gt>>

Similar  to  the B<#perl>/B<#lrep> environment, only this is a one-liner
version.

=back




=head1 EXAMPLES

To install the object C<named> in the hostgroup C<dnsservers>:

    pica -i +F named +H dnsservers

To install the objects C<motd> and C<proftpd> in  the  hosts  in
the group C<ftpservers> except to the host C<nt> just type:

    pica -i +F motd proftpd +H ftpservers -H nt

To  execute  the command C<killall -9 netscape> in the single
host C<solaris-1>:

    pica -x +F "killall -9 netscape" +H solaris-1




=head1 FILES

=over

=item F</etc/pica/pica.conf>

=item F</etc/pica/hosts.conf>

=item F</etc/pica/objects.conf>

=back




=head1 ENVIRONMENT VARIABLES

=over

=item B<PICAARGS>

contains arguments to automatically append to every B<pica> call.

=back




=head1 AUTHORS

=over

=item Miguel Angel Armas del Rio <kuko@maarmas.com>

=item Esteban Manchado Velazquez <zoso@demiurgo.org>

=back




=head1 SEE ALSO

B<ssh>(1) B<perl> (1)


=cut

use strict;
use Getopt::Long;
# For Debug
use Data::Dumper;
# Global PICA variables
use vars qw($VERSION $DEBUG $donothing $verbose %picadefs $objref
            $hostref $picacmd $picahost $picaobject $picacfg $picainclude
            $hostcfg $objcfg @picaflist $picafqdn $picasshuser $picashellcmd);

# Variable scope variables
use vars qw(%default
            %globalvars
            %hostvars
	   );

# Temporary arrays to build objectlist
use vars qw(@addobjlist @delobjlist);

# For copy
use File::Copy;
# For mkpath/rmpath
use File::Path;
# For dirname
use File::Basename;
# For finddepth
use File::Find;
# For recursive copy
use File::NCopy;


# Options
use vars qw($opt_i $opt_v $opt_f $opt_h $opt_l $opt_t $opt_x $opt_n $opt_d);

# command line options
use vars qw(@commands @hosts @objects @defs);

# pica configuration variables
use vars qw($sshpath $tarpath $diffpath $rsyncpath @protecteddirs);

# pica dirs
use vars qw($picaroot $picadir $picaalarms $picabin $picalib $picaobj
      $picasrc $picatmp);

# PICA Version
$VERSION = "0.4.1";

#----------------------------------------------[ Configuration Variables ]----

# Files where we have hosts, vars and objects definitions (they are read
# in this order)
$picacfg="/etc/pica/pica.conf";
$hostcfg="/etc/pica/hosts.conf";
$objcfg="/etc/pica/objects.conf";

# Where we have all PICA related stuff
$picadir="/var/lib/pica";
use lib '/usr/lib/pica';
use lib '/var/lib/pica';

#------------------------------------------[ End Configuration Variables ]----

# Config File Parsers
use picagroups;
use config;
use objects;
use hosts;
use user;

## SET THIS TO DEBUG
$DEBUG=0;

## Check if we have a PICAARGS env variable
if (exists $ENV{PICAARGS}) {
   push(@ARGV,split(" ",$ENV{PICAARGS}));
}

# ------------------------------------- [ Auxiliary Functions Definitions] ---

# FUNCTION: checkoptions()
# DESCRIPTION: Checks if the given options are correct
sub checkoptions {
    my $cmd;

    if ($opt_i) {
       $cmd = 'install';
    }
    if ($opt_x){
       if ($cmd) {
          print STDERR "ERROR: You can only give one command option \n";
	  usage();
       }
       else {
          $cmd = 'exec';
       }
    }
    if ($opt_l){
       if ($cmd) {
          print STDERR "ERROR: You can only give one command option \n";
	  usage();
       }
       else {
          $cmd = 'list';
       }
    }
    if ($opt_t){
       if ($cmd) {
          print STDERR "ERROR: You can only give one command option \n";
	  usage();
       }
       else {
          $cmd = 'del';
       }
    }
    if ($opt_f){
       if ($cmd) {
          print STDERR "ERROR: You can only give one command option \n";
	  usage();
       }
       else {
          $cmd = 'diff';
       }
    }
    if (!$cmd) {
       print STDERR "ERROR: You must give one command option \n";
       usage();
    }
    return $cmd;
}

# FUNCTION: usage()
# DESCRIPTION: Prints usage information
sub usage {
    print "(PICA) Perl Installation and Configuration Agent \n";
    print "Version: $VERSION \n";
    print <<__EOB__;
Usage: $0 -[ixtflh] [-n] [-v] [--with-picaconf newpica.conf]
          [--with-hostsconf newhosts.conf] [--with-objectsconf newobjects.conf]
          +D defines +|-F objects +|-H hosts
       -i : Install objects
       -x : Execute object/command
       -t : Delete object
       -f : Diff object
       -l : List objects
       -h : Shows this help
       -n : Do nothing. Do not install/delete things, just testing
       -d : Debug. Implies -n, gives more info, leaves some temp files
       -v : Be verbose

       --with-picaconf    : Changes pica.conf path
       --with-hostsconf   : Changes hosts.conf path
       --with-objectsconf : Changes objects.conf path

       +D   : Build defines list
       +|-F : Build object list
       +|-H : Build hosts list

__EOB__

    exit;
}

# FUNCTION: processObjectList (@objlist)
# DESCRIPTION: Process the object list. All objects should already be leaf
# objects. If we find a group object, we skip it.
sub processObjectList (@) {
    my @objlist = @_;
    my $type;
    my ($uid,$gid,$perms,$verbatim);
    my ($source,$path,$priority);
    my $picaargs;
    my $i=0;

    foreach $picaobject (@objlist) {
       # if $picaobject contains spaces, get only first word
       # (it could be an object to execute with arguments)
       $picaargs = "";
       if ($picaobject =~ /(.*?) (.*)/) {
          $picaobject = $1;
	  $picaargs   = $2;
       }

       # If cmd != exec, object MUST exist
       if (!exists $objref->{$picaobject}) {
          if ($picacmd eq 'exec') {
             my $sshargs = "-q -t";
	     my $cmd = "'$picaobject $picaargs'";
	     my $runcmd = eval "qq[$picashellcmd]";
	     print "  Running cmd: $runcmd \n" if $verbose;
	     system $runcmd unless $donothing;
	     next;
	  }
	  else {
	     print "Object $picaobject doesn't exist\n";
	     next;
	  }
       }

       # ***** Object Exists -> Get Object Type
       if (!($type = getAttr($picaobject,'type'))) {
          print STDERR "WARNING: 'type' property is mandatory. SKIPPING $picaobject \n";
	  next;
       }

       # Get mandatory properties, depending on object type
       # File -> Mandatory: source
       if ($type eq 'file') {
	  if (!($source = getAttr($picaobject,'source'))) {
	     print STDERR "WARNING: 'source' property is mandatory. SKIPPING file $picaobject \n";
	     next;
	  }
	  # If path isn't specified, we use source
	  if (!($path = getAttr($picaobject,'path'))) {
	     $path = $source;
	  }
          # prepend $picasrc if $source is relative
          $source = "$picasrc/$source" if ($source !~ /^\//);
          $path   = getHostAttr($picahost, 'defpathdir') . "/$path" if ($path !~ /^\//);
       }
       # Alarm -> Mandatory: priority, source
       elsif ($type eq 'alarm') {
	  if (!($priority = getAttr($picaobject,'priority'))) {
	     print STDERR "WARNING: 'priority' property is mandatory. SKIPPING alarm $picaobject \n";
	     next;
	  }
	  if (!($source = getAttr($picaobject,'source'))) {
	     print STDERR "WARNING: 'source' property is mandatory. SKIPPING alarm $picaobject \n";
	     next;
	  }
          # Make path using priority
	  $path = $picaalarms."/".$priority."/".$picaobject;

          # prepend $picasrc if $source is relative
          $source = "$picasrc/alarms/$source" if ($source !~ /^\//);
       }
       elsif ($type =~ /group$/) {
	  print STDERR "WARNING: We shouldn't find groups here. SKIPPING $picaobject \n";
	  next;
       }
       else {
          die "FATAL: Unknown object type: $type \n";
       }

       # Now, get common attributes
       $uid      = getAttr($picaobject,'uid');
       $gid      = getAttr($picaobject,'gid');
       $verbatim = getAttr($picaobject,'verbatim');
       $perms    = getAttr($picaobject,'perms');
       if ($type eq 'alarm') {
          $perms = oct $perms;
          $perms |= 0111;
          $perms = sprintf '%04o', $perms;
       }

       # Now , see what we have to do with this object
       if ($picacmd eq 'install') {
	  print "  $picaobject -> $path $uid.$gid $perms $verbatim \n" if $verbose;
	  installFile($source,"$picatmp/$picahost/$path",$uid,$gid,$perms,$verbatim);
       }
       elsif ($picacmd eq 'exec') {
          $path = $path."-picacaller" if ($type eq 'alarm');
	  my $sshargs = "-q -t";
	  my $cmd = "'$path $picaargs'";
	  my $runcmd = eval "qq[$picashellcmd]";
	  print "  Running obj: $runcmd \n" if $verbose;
          # SKIP If object is a directory
          if (-d $source) {
	     print "   *** $picaobject is a directory. SKIPPING *** \n";
	     next;
	  };
	  if ($donothing) {
	     print $runcmd, "\n";
	  }
	  else {
	     system $runcmd;
	  }
       }
       elsif ($picacmd eq 'del') {
          # When deleting alarms, also delete its picacaller script
          if ($type eq 'alarm') {
             $path .= " $path-picacaller";
          }

          my $sshargs = "-q";
	  my $cmd = "'rm -f $path'";
	  my $runcmd = eval "qq[$picashellcmd]";
	  print "  Deleting $path \n" if $verbose;
          # SKIP If object is a directory
          if (-d $source) {
	     print "   *** $picaobject is a directory. SKIPPING *** \n";
	     print "   *** For safety reasons PICA doesn't delete dirs recursively \n";
	     print "   *** You shoud delete $path manually \n";
	     next;
	  };
	  if ($donothing) {
	     print $runcmd, "\n";
	  }
	  else {
	     system $runcmd;
	  }
       }
       elsif ($picacmd eq 'list') {
          my $sshargs = "-q";
          my $cmd = "'ls -l $path'";
	  my $runcmd = eval "qq[$picashellcmd]";
	  if ($donothing) {
	     print $runcmd, "\n";
	  }
	  else {
	     system $runcmd;
	  }
       }
       elsif ($picacmd eq 'diff') {
	  print "  Diffing $picaobject: \n";
          # SKIP If object is a directory
          if (-d $source) {
	     print "-------- \n";
	     print "   *** $picaobject is a directory. SKIPPING *** \n";
	     print "-------- \n\n";
	     next;
	  };
	  # Install local file (what the object SHOULD BE)
	  installFile($source,"$picatmp/$picahost/$path",$uid,$gid,$perms,$verbatim);
          # diff against the remote file (what the object IS)
	  print "-------- \n";
	  diffObject($path);
	  print "-------- \n\n";
       }
       else {
          die "FATAL: Unknown command: $picacmd \n";
       }
   }        # foreach $picaobject (@objlist)
}

# FUNCTION: getAttr($objname,$attrname);
# DESCRIPTION: Returns the value of the object's attribute.
# all the group members
# Values precedence:
#  - Object values
#  - Group values
#  - Config defaults
#  - Code defaults (defined in this code)
sub getAttr {
    my $objname = shift;
    my $attrname = shift;
    my ($source,$path);
    my $attr="";

    # Code defaults
    my %def = (
               'uid'      => '0',
	       'gid'      => '0',
	       'perms'    => '644',
	       'verbatim' => '0',
              );

    # Initialize default value
    $attr = $def{$attrname} if (exists $def{$attrname});

    # Set global defaults if set
    $attr = $default{$attrname} if (exists $default{$attrname});

    # If the object is included in a group, read group's attr (except for type)
    if ((exists $objref->{$objname}{'group'}) && ($attrname ne 'type') &&
          ($attrname ne 'source')) {
       my $group=$objref->{$objname}{'group'};
       $attr = $objref->{$group}{$attrname}
              if (exists $objref->{$group}{$attrname});
    }

    # Set obect's attr if exists
    $attr = $objref->{$objname}{$attrname}
                               if ($objref->{$objname}{$attrname});

    return $attr;
}

# FUNCTION: getHostAttr($hostname,$attrname);
# DESCRIPTION: Returns the value of the host's attribute.
# Values precedence:
#  - Host values
#  - Config defaults
#  - Code defaults (defined in this code)
sub getHostAttr {
   my ($hostname, $attrname) = @_;
   my %hardcodeddefs = (
            'sshuser' => 'root',
            'fqdn'    => $hostname,
            'defpathdir'    => ''
         );
   my $result = $hardcodeddefs{$attrname} if exists $hardcodeddefs{$attrname};
   $result = $default{$attrname} if (exists $default{$attrname});
   $result = $hostref->{$hostname}{$attrname}
         if exists $hostref->{$hostname}{$attrname};
   return $result;
}

# FUNCTION: buildVars($objectname);
# DESCRIPTION: Returns a hash containing all the vars seen by the given
# object.
sub buildVars {
    my $objname = shift;
    my ($objvars,$groupvars);
    my %vars;

    # Host Variables
    %vars = %hostvars;

    # Group variables
    if (exists $objref->{$objname}{'group'} &&
        exists $objref->{$objref->{$objname}{'group'}}{'vars'}) {
       $groupvars = $objref->{$objref->{$objname}{'group'}}{'vars'};
       %vars = (%vars,%{$groupvars});
    }

    # Object variables
    if (exists $objref->{$objname}{'vars'}) {
       $objvars = $objref->{$objname}{'vars'};
       %vars=(%vars,%{$objvars});
    }

    # Create the sum
    %vars=(%vars,%picadefs);

    return %vars;
}

# FUNCTION: installTree()
# DESCRIPCION: Installs all the files in the subtree to the given host
sub installTree {
    my $dir = "$picatmp/$picahost";
    my $method = 'ssh';

    $method = getHostAttr ($picahost, 'method');

    if ($method eq 'rsync') {
       if (!$rsyncpath) {
          print STDERR "WARNING: Can't do rsync install without rsync. Will use ssh \n";
          $method = 'ssh';
       }
       else {
          # rsync install
	  my $v = "";
	  $v = "-v" if $DEBUG;

	  my @filelist = @picaflist;
	  map {s|^$picatmp/$picahost/||} @filelist;
	  my $filename = "$picatmp/$picahost-filelist.$$";
	  open(FD,">$filename") or
	                  die "ERROR Can't open $filename for writing: $!";
	  print FD join("\n",@filelist);
	  close FD;

	  my $runcmd = "$rsyncpath --include-from=$filename -e $sshpath -az $v $dir/ $picasshuser\@$picafqdn:/";
	  print "Installing files in $picahost (rsync) \n";
	  if ($donothing) {
	     print "cmd: $runcmd \n";
	  } else {
	     system $runcmd;
	  }
	  unlink $filename;
          return 0;
       }
    }
    if ($method eq 'tar') {
       if (!$tarpath) {
          print STDERR "WARNING: Can't do tar install without tar. Will use ssh \n";
          $method = 'ssh';
       }
       else {
          # tar install
	  my $v = "";
	  $v = "-v" if $DEBUG;
	  my @filelist = @picaflist;
	  map {s|^$picatmp/$picahost/||} @filelist;
	  my $filename = "$picatmp/$picahost-filelist.$$";
	  open(FD,">$filename") or
	                  die "ERROR Can't open $filename for writing: $!";
	  print FD join("\n",@filelist);
	  close FD;

          my $sshargs = "-q";
	  my $cmd = "'(cd /; tar xf - )'";
	  my $runcmd = eval "qq[$picashellcmd]";
	  $runcmd = "(cd $dir ; $tarpath $v cf - -T $filename )| ".
	               "$runcmd";
	  print "Installing files in $picahost (tar) \n";
	  if ($donothing) {
	     print "cmd: $runcmd \n";
	  } else {
	     system $runcmd;
	  }
	  unlink $filename if (!$DEBUG);
	  return 0;
       }
    }

    # SSH install
    # $picaflist contains the list of files we need to install
    print "Installing files in $picahost (SSH) \n";
    print STDERR "WARNING: SSH method is painfully slow. You should consider using tar or rsync \n";
    foreach my $filename (@picaflist) {
       my @tmp = stat($filename);
       my $perms = sprintf("%04o",$tmp[2] & 07777);
       my $uid = $tmp[4];
       my $gid = $tmp[5];
       my $src = $filename;
       my $dst = $filename;
       $dst =~ s|$picatmp/$picahost||;
       sshInstallFile($src,$dst,$uid,$gid,$perms);
    }
}

# FUNCTION: processFile()
# DESCRIPCION: process a file entry. This is used as a callback function for
# the File::Find and install every file in a given directory
sub processFile {
    my $filename = $_;
    my $dirname = $File::Find::dir;

    push @picaflist, "$dirname/$filename" if -f "$dirname/$filename";
}

# FUNCTION: installFile($src,$dst,$uid,$gid,$perms,$verbatim);
# DESCRIPTION: Installs a file with the given properties
sub installFile ($$$$$$) {
    my $src = shift;
    my $dst = shift;
    my $uid = shift;
    my $gid = shift;
    my $perms = shift;
    my $verbatim = shift;
    my $objname = $picaobject;
    my $dstdir = dirname $dst;

    # Create destdir if it doesn't exist (mkpath - man File::Path)
    if (! -d $dstdir ) {
       mkpath([$dstdir],0,0755);
    }

    my %vars;
    # Alarms are a special case: we have to install also the caller script
    if ($objref->{$objname}{'type'} eq 'alarm') {
       %vars = buildVars($objname);
       my $alarmpath = $dst; $alarmpath =~ s:^$picatmp/$picahost/::;
       my $callerpath = "$picatmp/tmpcaller";
       my $callingconv;
       if (defined $objref->{$objname}{'calling-convention'}) {
          $callingconv = $objref->{$objname}{'calling-convention'};
       } else {
          $callingconv = "";
       }
       open CS, ">$callerpath" or die "Can't open $callerpath for writing\n";
       print CS <<EOF;
#!/bin/sh
PERL5LIB=\$PERL5LIB:/usr/local/lib/site_perl $alarmpath <# return qq($callingconv); #> "\$@"
EOF
       close CS;
       preProcessFile ($callerpath, $dst . '-picacaller', %vars);
       unlink $callerpath;
       # Set executable permission for picacaller
       chown $uid,$gid,$dst . '-picacaller';
       chmod oct($perms),$dst . '-picacaller';
    }

    # If a directory, copy recursively (implies verbatim)
    if (-d $src) {
       # The destination directory must exist in order to make NCopy::copy work
       if (! -d $dst) {
          mkpath([$dst],0,0755);
       }
       # If directory ends with "/" copy CONTENTS of directory (as in rsync)
       $src = "$src/*" if ($src =~ /.*\/$/);
       File::NCopy::copy (\1, $src, $dst);
    # If verbatim, just copy it
    } elsif ($verbatim) {
       if (!copy($src,$dst)) {
          print STDERR "ERROR copying $src -> $dst : $! \n";
	  return 0;
       }
    } else {
       # Build vars for this object/host, unless we've already done it
       %vars = buildVars($objname) unless %vars;
       if ($DEBUG) {
          print "****** OBJVARS ******\n";
	  print Dumper(\%vars);
	  print "**** END OBJVARS ****\n";
       }

       # Pre-process file
       preProcessFile($src,$dst,%vars);
    }

    # Now set attributes
    $perms = oct($perms);
    chown $uid,$gid,$dst;
    chmod $perms,$dst;
}

# FUNCTION: getAllObjects($listref);
# DESCRIPTION: Returns an array with all leaf object (non-group) names.
sub getAllObjects {
   my $ref = shift;

   return grep { $_ ne 'defaults' && $ref->{$_}{'type'} !~ /group$/ }
               keys %$ref;
}

# FUNCTION: getAllAlarms($listref);
# DESCRIPTION: Returns an array with all the alarms and dependencies
sub getAllAlarms {
   my ($listref, $type) = (shift, shift);
   my @result;

   foreach my $k (keys %$listref) {
      next if $k eq 'defaults';
      # Add every alarm and its dependencies
      if ($listref->{$k}{'type'} eq 'alarm') {
         push @result, $k;
         next unless $listref->{$k}{'members'};
         foreach my $dep (@{$listref->{$k}{'members'}}) {
            push @result, $dep;
         }
      }
   }

   return @result;
}

# FUNCTION: diffObject($objpath)
# DESCRIPTION: diff an object against the one installed in the
# host
sub diffObject {
    my $objpath = shift;
    my ($rmtfile,$localfile);

    # Check for diff path
    if (!$diffpath) {
       print STDERR "ERROR: Can't diff wihout diff path. Check configuration \n";
       return;
    }

    $localfile = "$picatmp/$picahost/$objpath";
    $rmtfile = "$picatmp/$picahost/${objpath}.installed";
    # Get the remote file
    # We don't need to create the path because we have previously done so in
    # installFile
    sshGetFile($objpath,$rmtfile);
    system "$diffpath -u $rmtfile $localfile";
}

# FUNCTION: sshInstallFile($src,$dst,$uid,$gid,$perms);
# DESCRIPTION: Installs a file in a remote host using ssh.
sub sshInstallFile {
    my $src = shift;
    my $dst = shift;
    my $uid = shift;
    my $gid = shift;
    my $perms = shift;

    my $dstdir = dirname($dst);
    my $sshargs = "-q";
    my $cmd = "";
    my $runcmd = eval "qq[$picashellcmd]";
       $runcmd  = "cat $src | $runcmd \"mkdir -p $dstdir ;";
       $runcmd .= " cat > $dst ; chown $uid.$gid $dst ; chmod $perms $dst\"";
	
    if ($donothing) {
       print $runcmd, "\n";
    }
    else {
       system $runcmd;
    }
}

# FUNCTION: sshGetFile($src,$dst);
# DESCRIPTION: Gets a remote file via SSH and writes it to $dst
sub sshGetFile {
    my $src = shift;
    my $dst = shift;

    my $sshargs = "-q";
    my $cmd = "'[ -f $src ] && cat $src '";
    my $runcmd = eval "qq[$picashellcmd]";
    $runcmd  = "$runcmd | cat > $dst";
    system $runcmd;
}

# FUNCTION: preProcessFile($src,$dst,%vars);
# DESCRIPTION: preProcess $src file, expandins %vars and writing to $dst
sub preProcessFile ($$%) {
   my ($infile, $outfile, %vars) = @_;

   no strict;

   # Import variables to local namespace
   # my ($caller_package) = caller;
   foreach my $varname (keys %vars) {
      #*{"${caller_package}::${var_name}"} = \$vars{$var_name};
      *{"${varname}"} = \$vars{$varname};
   }

   open OUTFILE, ">$outfile" or die "Can't open $outfile for writing\n";

   appendOutput ($infile, \*OUTFILE);

   # Unset all imported variables
   foreach my $varname (keys %vars) {
      undef ${$varname};
   }
   
   close OUTFILE;
}


sub appendOutput ($$) {
   no strict;
   my ($infile, $fh) = @_;
   my $linenumber = 1;
   # Internal state: either 'if', 'nif', 'elsif', 'nelsif', 'ignoreelsif',
   # 'else' or 'nelse'
   my @internal_state;
   my $perl = 0;              # If in #perl/#lrep environment
   my $perlbuffer = "";       # Perl expression buffer for #perl/#lrep
   local *F;

   local $SIG{__WARN__} = sub {
      my $warning = $_[0];
      $warning =~ s/ at .+?$//;
      print 'Perl warning in ', $infile, ', line ', $linenumber - 1, ': ', $warning;
   };

   open F, $infile or die "Can't open $infile\n";
   while (<F>) {
      my $current_line = $_;
      $linenumber++;

      # First of all, check for #perl/#lrep state ------------
      if ($current_line =~ /^#perl\s*$/ and ! $perl) {
         $perl = 1;        # Switch to perl mode
         $perlbuffer = "";
         next ;
      }

      if ($current_line =~ /^#lrep\s*$/) {
         if ($perl) {
            $perl = 0;
            print $fh eval $perlbuffer;
            print "WARNING: error eval'ing \"$perlbuffer\": ", $@, "\n" if $@;
         } else {
            print "Warning: #lrep found outside #perl environment!\n";
         }
         next ;
      }

      # Changes in @internal_state ---------------------------
      #if (...)
      if ($current_line =~ /^#\s*if\s*\((.*)\)\s*$/) {
         die "$infile: $linenumber: #if without condition\n"
               unless $1;
         if (eval $1) {
            unshift @internal_state, 'if';
         } else {
            print "WARNING: error eval'ing \"$1\": ", $@, "\n" if $@;
            unshift @internal_state, 'nif';
         }
         next ;
      }

      #else
      if ($current_line =~ /^#\s*else\s*$/) {
         if ($internal_state[0] =~ /else/) {
            die "$infile: $linenumber: unexpected #else\n";
         } elsif ($internal_state[0] =~ /^n/) {
            if ($internal_state[0] ne 'ignoreelsif') {
               shift @internal_state;
               unshift @internal_state, 'else';
            }
         } else {
            shift @internal_state;
            unshift @internal_state, 'nelse';
         }
         next ;
      }

      #elsif (...) / elif (...)
      if ($current_line =~ /^#\s*(els?if)\s*\((.*)\)\s*$/) {
         my $exp = $2;
         if ($internal_state[0] =~ /else/) {
            die "$infile: $linenumber: unexpected #$1\n";
         }

         # 'ignoreelsif' means we have already evaluated the if part or one of
         # the elsif ones; 'nelsif', haven't evaluated anything yet
         if ($internal_state[0] !~ /^n/) {
            # Already evaluated something: ignore the rest
            shift @internal_state;
            unshift @internal_state, 'ignoreelsif';
         } else {
            if (eval $exp) {
               shift @internal_state;
               unshift @internal_state, 'elsif';
            } else {
               print "WARNING: error eval'ing \"$exp\": ", $@, "\n" if $@;
            }
         }
         next ;
      }

      #fi
      if ($current_line =~ /^#\s*fi\s*$/) {
         unless (scalar @internal_state) {
            die "$infile: $linenumber: unexpected #fi!!\n";
         }
         shift @internal_state;
         next ;
      }

PROCESS_DATA:
      # Process data? ----------------------------------------
      next if scalar grep /^n|ignoreelsif/, @internal_state;

      # Included file: treat recursively
      if ($current_line =~ /^#\s*include\s*([<"])(.+)([>"])/) {
         my ($firstchar, $filename, $lastchar) = ($1, $2, $3);
         # Check if the characters are correct. If not, just print the line
         # and go on (don't treat as a directive)
         if (($firstchar eq '<' and $lastchar ne '>') or
             ($firstchar eq '"' and $lastchar ne '"')) {
            print $fh $current_line;
            next ;
         }
	 # eval $filename to be able to use variables in path
	 $filename = eval "\"$filename\"";	
         # If it's not an absolute path, add $picainclude at the beginning. If
         # not, get the file relative to the input file
         if ($firstchar eq '<' and $filename !~ m:^/:) {
            $filename = $picainclude . '/' . $filename;
         } elsif ($filename !~ m:^/:) {
            $filename = dirname ($infile) . '/' . $filename;
         }
         &appendOutput ($filename, $fh);
         next ;
      }

      if ($perl) {
         $perlbuffer .= $current_line;
	 next ;
      }

      # Expand inlined #perl/#lrep environments before printing
      while ($current_line =~ /<#(.*?)#>/) {
         my $exp = $1;
         my $result = eval $exp;
         print "WARNING: error eval'ing \"$exp\": ", $@, "\n" if $@;
	 $current_line =~ s/<#.*?#>/$result/;
      }

      print $fh $current_line;
   }

   if (scalar grep /^n/, @internal_state) {
      die "$infile: unexpected EOF\n";
   }
}

# FUNCTION: parseCla (\@ARGV)
# DESCRIPTION: sets @commands, @defs, @hosts and @objects to lists with the
# elements found in the command line arguments. It puts a '-' in front of any
# name found after a substraction command
sub parseCla ($) {
	my $ref = shift;
	my $aref = 0;
	my $action = '';

	foreach my $i (@$ref) {
		last if ($i eq '--');

		if ($i =~ /^([+-])(.)/) {
			$action = ($1 eq '-')?'-':'';

			if ($2 eq 'C') {
				$aref = \@commands;
			} elsif ($2 eq 'H') {
				$aref = \@hosts;
			} elsif ($2 eq 'F') {
				$aref = \@objects;
			} elsif ($2 eq 'D') {
				$aref = \@defs;
			} else {
				die "Unknown" . ($action?" option or":"") .
                                      " object type ", $2, "\n";
			}
		} else {
			push @$aref, "$action$i";
		}
	}
}

# FUNCTION: checkDir ($dirname, $dir, @protecteddirs)
# DESCRIPTION: Checks if the given $dir is in the given list of protected
# directories. If yes, die with an error message.
sub checkDir ($$@) {
   my ($dirname, $dir, @protected) = @_;

   for my $d (@protected) {
      if ($dir eq $d) {
         die "ERROR: $dirname is set to a protected dir ($dir). \n".
             "Are you trying to shoot yourself in the foot!!!?? \n";
      }
   }
}

# FUNCTION: updateDefines (@defs)
# DESCRIPTION: Updates %picadefs with all the definitions found at command
# line (from the special array @defs, similar to @objects and @hosts)
sub updateDefines (@) {
   for my $d (@_) {
      $d =~ /(.+)=(.+)/;
      my ($var, $val) = ($1, $2);
      # Definitions can be both +D variable=value and +D variable. In that
      # case, we suppose variable=1
      if ($var) {
         $picadefs{$var} = $val;
      } else {
         $picadefs{$d} = '1';
      }
   }
}

# --------------------------------- [ End Auxiliary Functions Definitions] ---

# --------------------------------------- [ Parse command line arguments ] ---
Getopt::Long::Configure('bundling','pass_through','no_getopt_compat','no_ignore_case');
GetOptions('i','v','f','h','l','t','x','n','d',
      'with-picaconf=s',    \$picacfg,
      'with-hostsconf=s',   \$hostcfg,
      'with-objectsconf=s', \$objcfg);

# Check the command options...
$verbose = 1 if ($opt_v);
$DEBUG = 1 if ($opt_d);
$donothing = 1 if ($opt_n or $opt_d);
usage() if ($opt_h);

# Get the command from the given options
$picacmd = checkoptions();

# Process non-option arguments to build objects/hosts list
parseCla (\@ARGV);
# ----------------------------------- [ End parse command line arguments ] ---

# Read config
my $configreader = new config;
unless ($configreader->loadConfig($picacfg)) {
   die "ERROR parsing config file\n";
}

updateDefines (@defs);

# Build hosts list
my $tmpfile = "/tmp/hosts_$$.conf";
preProcessFile($hostcfg,$tmpfile,%picadefs);
my $p = new hosts;
unless ($p->fillHostRef($tmpfile)) {
   die "ERROR parsing hosts file\n";
}
# Delete temp file
unlink $tmpfile if (!$DEBUG);

# Print hosts
if ($DEBUG) {
   print "****** HOSTS ******\n";
   print Dumper($hostref);
   print "**** END HOSTS ****\n";
}

# Set defaults and global variables
if (exists $hostref->{'defaults'}) {
   %default = %{$hostref->{'defaults'}};
}
delete $default{'vars'};
if (exists $hostref->{'defaults'}{'vars'}) {
   %globalvars = %{$hostref->{'defaults'}{'vars'}};
}

# Check if pica is correctly configured (we need some config variables)
if (!$sshpath) {
   die "Config ERROR: We need the path to the ssh client \n";
}
if (!$picaroot) {
   die "Config ERROR: We need the 'picaroot' directory \n";
}

# Initialize pica directories
if ($default{'picaalarms'}) {
   $picaalarms = eval "\"$default{'picaalarms'}\"";
} else {
   $picaalarms = eval "\"$picaroot/alarms\"";
}
if ($default{'picabin'}) {
   $picabin = eval "\"$default{'picabin'}\"";
} else {
   $picabin = eval "\"$picaroot/bin\"";
}
if ($default{'picalib'}) {
   $picalib = eval "\"$default{'picalib'}\"";
} else {
   $picalib = eval "\"$picaroot/lib\"";
}
if ($default{'picaobj'}) {
   $picaobj = eval "\"$default{'picaobj'}\"";
} else {
   $picaobj = eval "\"$picaroot/obj\"";
}

print "picaalarms : $picaalarms \n" if $DEBUG;
print "picabin    : $picabin \n" if $DEBUG;
print "picalib    : $picalib \n" if $DEBUG;
print "picaobj    : $picaobj \n" if $DEBUG;
print "picatmp    : $picatmp \n" if $DEBUG;

checkDir ("picatmp", $picatmp, @protecteddirs);

print "\nWon't install/delete anything \n" if $donothing;

# Calculate host list, removing hosts in special group 'sysdown'
push @hosts, '-sysdown';
@hosts = picagroups::expandHosts ($hostref, @hosts);
die "Empty host list. Check your host arithmetic! \n" unless scalar @hosts;

print "Hostlist: ".join(" ",@hosts),"\n" if $DEBUG;

# For every host, process every object
foreach $picahost (@hosts) {
   print "Processing host: $picahost \n" if $verbose;

   # Empty filelist (@picaflist)
   @picaflist = ();

   $picafqdn = getHostAttr ($picahost, 'fqdn');
   $picasshuser = getHostAttr ($picahost, 'sshuser');
   $picashellcmd = getHostAttr ($picahost, 'shellcmd');

   # Set default picashellcmd
   $picashellcmd = "$sshpath \$sshargs $picasshuser".'\@'."$picafqdn \$cmd" if (!$picashellcmd);

   # First delete host tree
   # Make sure we aren't going to rm "/"
   checkDir ("$picahost directory ($picatmp/$picahost)", "$picatmp/$picahost",
         @protecteddirs);
   rmtree(["$picatmp/$picahost"]);

   ## Build the variables seen by this host
   # Global variables
   %hostvars = %globalvars;

   # Group variables
   if (exists $hostref->{$picahost}{'groups'}) {
      foreach my $group (@{$hostref->{$picahost}{'groups'}}) {
         if (exists $hostref->{$group}{'vars'}) {
	    %hostvars = (%hostvars,%{$hostref->{$group}{'vars'}});
	 }
      }
   }
   # Host specific variables
   if (exists $hostref->{$picahost}{'vars'}) {
      %hostvars = (%hostvars,%{$hostref->{$picahost}{'vars'}});
   }

   # Build the object structure seen by this host
   undef $objref;
   my $tmpfile = "$picatmp/objects_${picahost}_$$.conf";
   preProcessFile($objcfg,$tmpfile,%hostvars);
   my $p = new objects;
   unless ($p->fillObjRef($tmpfile)) {
      die "ERROR parsing object file\n";
   }
   # Delete temp file
   unlink $tmpfile if (!$DEBUG);

   # Print objects for this host
   if ($DEBUG) {
      print "****** OBJECTS ******\n";
      print Dumper($objref);
      print "**** END OBJECTS ****\n";
   }

   # Get defaults definitions in objects.conf
   if (exists $objref->{'defaults'}) {
      my %tmpdefault = %{$objref->{'defaults'}};
      delete $tmpdefault{'vars'};
      %default = (%default,%tmpdefault);
      if (exists $objref->{'defaults'}{'vars'}) {
         %hostvars = (%hostvars,%{$objref->{'defaults'}{'vars'}});
      }
   }

   # Print defaults
   if ($DEBUG) {
      print "****** DEFAULTS ******\n";
      print Dumper(\%default);
      print "**** END DEFAULTS ****\n";
   }

   # Print variables for this host
   if ($DEBUG) {
      print "****** HOSTVARS ******\n";
      print Dumper(\%hostvars);
      print "**** END HOSTVARS ****\n";
   }

   my @objlist = picagroups::expandObjects ($objref, $picacmd, @objects);

   # Print variables for this host
   if ($DEBUG) {
      print "****** OBJECTS ******\n";
      print Dumper(@objlist);
      print "**** END OBJECTS ****\n";
   }

   if (!@objlist) {
      print STDERR "  WARNING: Empty object list for $picahost\n";
      next;
   }

   # This function does all the dirty work
   processObjectList(@objlist);

   # If cmd install install tree
   if ($picacmd eq 'install') {
      my @files;
      if (-d "$picatmp/$picahost") {
         finddepth(\&processFile,"$picatmp/$picahost");
         installTree();
      } else {
         print "All of the distribution files were rejected or don't exist!\n";
      }
   }
   print "\n" if $verbose;
   if (($picacmd eq 'install') && (!$DEBUG)) {
      rmtree(["$picatmp/$picahost"]);
   }
}
