[Acd-checkins] CVS: acd-1/windows acd_client_windows.pl,NONE,1.1

[Josh L. <ru...@us...>]

Update of /cvsroot/acd/acd-1/windows
In directory sc8-pr-cvs1:/tmp/cvs-serv14498/windows

Added Files:
	acd_client_windows.pl 
Log Message:
New checkin of tmd's windows stuff.


--- NEW FILE: acd_client_windows.pl ---
#!/usr/local/bin/perl5 -w

# copyright 2001,2002 Josh Lothian
#
# This file is part of ACD.
#
# ACD 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.
#
# ACD 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 ACD; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


use LWP::UserAgent;
use Digest::MD5;      # needed for checksums
use Getopt::Std;
use Data::Dumper;


use strict;

#my $DEBUG=0;
my $DEBUG=1;
my $SAVE_XML=0;
my %opts;
my $config_file;
my %config;
my $acd_proxy='';

getopts('c:dp',\%opts);
# -c takes a config file as an argument
# -d sets debug mode
if(defined($opts{'c'})) {
  $config_file=$opts{'c'};
} else {
  $config_file='C:\\acd.conf';
}

if(defined($opts{'d'})) {
  $DEBUG=1;
}

if(defined($opts{'p'})) {
  $SAVE_XML=1;
}

dprint ("Debug mode is on\n");  
dprint ("Using config file: $config_file\n");

open CONFIG,$config_file or die "$config_file: $!\n";
my $line_num=0;
open CONFIG, "<".$config_file or die "$config_file: $!\n";
while (<CONFIG>) {
  if(not /^\#/) {
    my $var;
    my $val;
    ($var,$val)=split(/=/);
    dprint ("Read var: $var with value $val");
    chomp $val;
    die "$config_file: Error on line $line_num\n" if(not(defined $val));
    $config{$var}=$val;
  }
}

my $FORCE_FQDN="$config{'FORCE_FQDN'}";
dprint ("Using FQDN: $FORCE_FQDN\n");
if(defined($config{'acd_proxy'})) {
  $acd_proxy="$config{'acd_proxy'}";
  dprint ("Using proxy: $acd_proxy\n");
}
my $URL="$config{'acd_http_root'}/$config{'acd_server_script'}";
dprint ("Using url: $URL\n");
my $BASEDIR=$config{'acd_local_dir'};
dprint ("Base directory: $BASEDIR\n");

if (not -d $BASEDIR) {
  dprint ("$BASEDIR does not exists, creating ...\n");
  mkdir("$BASEDIR",0770);
}

my $UNAME;
my $OS;
my $OSVER;
my $OSstring;
my $hostname;
my $ua;
my $url;
my @files;
my $sum;
my $file;
my @download_list;
my $filereq;
my $fileresult;
my $exe;

$OS="windows";
my @temp=split(' ', `ver`);
$OSVER=$temp[2];

$OSstring="$OS-$OSVER";

dprint ("Detected $OSstring\n");

# this works for at least solaris and linux
# FIXME: test on HP

#$hostname=`/bin/hostname`;
$hostname=`hostname`;
chomp $hostname;

# Added by cgreer to force resolution to a full name instead of a
# short hostname.  This should be a config option.
dprint ("Found hostname: $hostname\n");
if (defined($FORCE_FQDN)) {
  use Net::Domain qw(hostname hostfqdn hostdomain);
  $hostname=hostfqdn($hostname);
  dprint ("  ..becomes $hostname\n");
}


# create our UserAgent
$ua = new LWP::UserAgent;
$ua->agent("AgentName/0.1 " . $ua->agent);

if ($acd_proxy ne '') {
  $ua->proxy('http',$acd_proxy);
}


# Create a request
my $req = new HTTP::Request POST => "$URL";
$req->content_type('application/x-www-form-urlencoded');

# request that the server send us a URL for the
# appropriate OS and OS version.  The first line received
# should be a URL containting the path to the os-specific
# files.  subsequent lines give current MD5 checksums for
# any files in that directory

if($DEBUG==1) {
  $req->content("action=send_file_url&debug=yes&os=$OSstring");
} else {
  $req->content("action=send_file_url&os=$OSstring");
}

# Pass request to the user agent and get a response back
my $res = $ua->request($req);

# Check the outcome of the response
if (not $res->is_success) {
  print STDERR "send_file_url failed, exiting ...\n";
  dprint("Error returned was: ", $res->content);
  exit;
} else {
  my @content=split ("\n",$res->content);
  my @filtered_content=grep(!/^$|^Content-Type/, @content);
  ($url, @files)=@filtered_content;
  dprint ("Main file URL: $url\n");
}

# @files is a list of checksums and files.  Use this to determine
# what needs to be downloaded
dprint ("Files:",join('\n',@files),"\n");

foreach (@files) {
  ($sum,$file)=split " ", $_;
  if ( not -f "$BASEDIR\\$file" ) {
    dprint ("New file: $file\n");
    push @download_list,$file;
  } elsif ( checksum($BASEDIR."\\".$file) ne $sum) {
    push @download_list,$file;
    dprint ("New checksum: $file\n");
  }
}

#print "\n";
foreach (@download_list) {
  $file=$_;
  dprint ("Downloading: $url/$file ... ");
  $filereq=new HTTP::Request GET => "$url/$file";
  $fileresult=$ua->request($filereq, "$BASEDIR\\$file");
  if ($fileresult->is_success) {
    dprint ("File grabbed successfully!\n");
  } else {
    print STDERR "Error grabbing script file: $url/$file\n";
    exit;
  }
}

my $bigoutput;
my @output;
my $sendresult;
# now, collect the output from the client programs
dprint ("chdir'ing to $BASEDIR\n");
chdir "$BASEDIR";
foreach $exe (glob "*") {
  dprint ("Running: $BASEDIR\\$exe\n");
  push @output, `$BASEDIR\\$exe`;
}

#construct output

$bigoutput="<machine>
  <basic_info>
    <hostname>$hostname</hostname>
    <os>$OS</os>
    <osver>$OSVER</osver>
  </basic_info>
" . join('', @output) . "\n</machine>";
#print "$bigoutput\n";

dprint ("Sending this to server: \n$bigoutput\n");
if($SAVE_XML==1) {
  open XML,">$BASEDIR\\recent.xml" or die "$BASEDIR\\recent.xml: $!\n";
  print XML $bigoutput;
  close XML or die "$BASEDIR\\recent.xml: $!\n";
}

# send the output to the server
$req = new HTTP::Request POST => "$URL";
$req->content_type('application/x-www-form-urlencoded');
if($DEBUG==1) {
  $req->content("action=accept_data&debug=yes&data=$bigoutput");
} else {
  $req->content("action=accept_data&data=$bigoutput");
}
$sendresult=$ua->request($req);
if($sendresult->is_success) {
  dprint ("Got back from server: ".$sendresult->content."\n");
}

sub checksum {
  my $filename=shift;
  open FILE, "$filename" or die "$filename: $!\n";
  binmode(FILE);
  return Digest::MD5->new->addfile(*FILE)->hexdigest;
}

sub dprint {
  if($DEBUG==1) {
    print STDERR @_;
  }
}