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