Show update.pl syntax highlighted
#!/usr/bin/perl -w
use strict;
use FindBin;
use lib qw( $FindBin::Bin . );
use File::Spec::Functions;
use IO::Socket;
use IO::Select;
use IO::Dir;
use Digest::MD5 qw( md5_hex );
use Getopt::Long;
use File::Path;
use File::Basename;
use util;
use Client;
use Data::Dumper;
use constant 'EOL' => "\015\012";
use vars qw(
$VERSION
$CONFIG $DEFPORT
$FILES
$SCREENWIDTH
$conf $parms $exclude
$READKEY
);
# determine maximum width of the terminal/screen. Wrap it in an eval to trap fatal errors (not everyone has this installed)
eval "use Term::ReadKey qw(GetTerminalSize)";
if (!$@) {
my ($w,$h) = (GetTerminalSize(\*STDOUT));
$SCREENWIDTH = $w ? $w - 1 : 79;
$READKEY = 1;
} else {
$SCREENWIDTH = 79;
$READKEY = 0;
}
$| = 1;
$VERSION = '1.04';
$CONFIG = getprogbasename . '.cfg';
$DEFPORT = 20563;
$conf = loadconfig(filename => $CONFIG, fatal => 1);
delete $conf->{version}; # do not allow this in the config
delete $conf->{files};
showusage() unless GetOptions(
'<>' => \&GetOptions_callback, # captures filenames put on the command line
'files|f=s' => \@{$parms->{files}}, # can use -files as well
'binaryfiles=s' => \$parms->{binaryfiles},
'exclude=s' => \@{$parms->{exclude}},
'force' => \$parms->{force}, # force file updates, ignoring the @excluded
'path=s' => \$parms->{path},
'server=s' => \$parms->{server},
'software=s' => \$parms->{software},
'username|u=s' => \$parms->{username},
'password|p=s' => \$parms->{password},
'version' => \$parms->{version},
'yes' => \$parms->{yes},
);
foreach my $p (keys %$parms) {
next unless defined $parms->{$p};
# if parmater is an array, ADD its values to whatever is defined in the config (do not overwrite), or just overwrite SCALARS
if (ref $parms->{$p} ne 'ARRAY') {
$conf->{$p} = $parms->{$p};
} else {
my $old = $conf->{$p};
unless (ref $conf->{$p} eq 'ARRAY') {
$conf->{$p} = defined $old ? [ $old ] : [ ];
}
push(@{$conf->{$p}}, @{$parms->{$p}});
}
}
$conf->{software} = 'psychostats2.0' unless defined $conf->{software};
$conf->{binaryfiles} = 'gif jpg png swf zip exe rtf dat' unless defined $conf->{binaryfiles};
# We want to force the update of files, so we clear the exclude array
if ($conf->{force}) {
$conf->{exclude} = [];
}
# convert exclude array into a hash for faster/easier lookups
foreach my $e (@{$conf->{exclude}}) {
next if !defined $e or $e eq '';
$e =~ tr|\\|/|;
$exclude->{$e} = 1;
}
$conf->{path} =~ tr|\\|/| if defined $conf->{path}; # convert \ into /
if (!$conf->{path} or $conf->{path} =~ /^\.\/?$/) { # no path, '.', or './'
$conf->{path} = $FindBin::Bin;
}
$conf->{path} = $conf->{path} . '/' unless $conf->{path} =~ m|/$|; # make sure trailing '/' is present
#for (my $i=0; $i < @{$conf->{files}}; $i++) { # add the software path to all files specified
# $conf->{files}->[$i] = $conf->{path} . $conf->{files}->[$i];
#}
{ # localize the temporary variables used in the block {}
my ($host,$port) = split(/:/, $conf->{server}, 2);
if (defined $port && $port =~ /^\d+$/) {
$conf->{server} = $host;
$conf->{port} = $port;
} elsif (!defined $port) {
$conf->{server} = $host if defined $host;
$conf->{port} = $DEFPORT;
} else {
$port = $DEFPORT unless defined $port;
logerror("Invalid server:port specified: [$host:$port]", 1);
}
if (defined(my $ip = gethostip($host))) {
$conf->{ip} = $ip;
} else {
logerror("Unable to resolve host: $host\n", 1);
}
}
# create regexp sub to check for binary file extensions
{
my $exts = lc join('|', split(/[,\.\s]+/, $conf->{binaryfiles}));
$exts =~ s/\|{2,}/|/g; # get rid of extra "|" if present
eval "sub isBinary { return (lc \$_[0] =~ /\\.($exts)\$/) }";
}
showusage(1) if $parms->{version};
print STDERR "Scanning local files in $conf->{path} ... ";
$FILES = {};
my $filelist = gatherFiles($conf->{path});
foreach my $file (@$filelist) {
$file =~ tr|\\|/|;
my $f = substr($file, length($conf->{path})); # substr() removes the leading absolute path
my $buffer = '';
next unless -f $file;
open(FILE, "<$file") or next; # ignore files that do not exist or are not readable
binmode(FILE);
$buffer = join('', <FILE>);
close(FILE);
if ($^O eq 'MSWin32' && !isBinary($f)) { # convert text files from win32 to linux format
$buffer = win2lin($buffer);
}
$FILES->{$f} = md5_hex($buffer);
}
print STDERR "OK (" . scalar(keys %$FILES) . " files)\n";
if (scalar(keys %$FILES) == 0) {
print STDERR "No files selected for updating.\n";
exit;
}
print STDERR "Connecting to $conf->{server}:$conf->{port} ... ";
my $socket = initSocket();
my $srv = new Client($socket);
print STDERR "OK\n";
print STDERR ">>> Authorizing ... ";
if (!defined $conf->{username} or $conf->{username} eq '' or !defined $conf->{password} or $conf->{password} eq '') {
print STDERR "\nLogin with your username and password from the psychostats.com website\n";
print STDERR "If you do not have an account go register now.\n";
my $retry = 1;
while ($retry <= 3 and !$conf->{username}) {
print "Username: ";
chomp($conf->{username} = <>);
last if defined $conf->{username} and $conf->{username} ne '';
$retry++;
}
if (!$conf->{username}) {
print STDERR "Login Aborted.\n";
exit;
}
$conf->{password} = prompt_password() if !$conf->{password};
}
$conf->{username} = trim($conf->{username});
$conf->{password} = trim($conf->{password});
$srv->sendmsg("AUTH " . lc(md5_hex($conf->{password})) . " " . $conf->{username});
if (my ($code, $msg) = $srv->getack) { # wait for ACK packet
if ($code == 0) {
print STDERR "FAILED: $msg\n";
exit(1);
} elsif ($code == 1) {
print STDERR "OK\n";
} else {
logerror("Unknown authorization response ($code): $msg", 1);
}
}
# If we didn't authorize (or you are attempting to remove the above step) the update command
# will not work and the server will simply disconnect you.
print STDERR ">>> Sending UPDATE request ... ";
$srv->sendmsg("UPDATE $conf->{software}"); # send the UPDATE command
if (my ($code, $msg) = $srv->getack) { # wait for ACK packet
logerror("Server Error: $msg",1) if !$code; # die due to server error (FALSE code returned)
print STDERR "OK\n";
if (!defined($msg = $srv->getmsg)) {
# $srv->sendack(0, "Invalid list header");
logerror("Server sent invalid header message.",1);
}
my ($files, $bytes) = split(/\s+/, $msg);
return 0 if !$files or !$bytes;
# STEP 1: get filelist
my $input = '';
if (!defined($input = $srv->getmsg)) {
logerror("Server did not send updated file list.",1);
}
# read each file from the server and determine if it's 'newer' than our current version
my @updated = ();
# my $selectfiles = @{$conf->{files}}; # total files selected ((>=1) == true)
my $selectfiles = { map {$_, 1} @{$conf->{files}} };
foreach my $line (split(EOL, $input)) {
$line = trim($line);
my ($md5, $file) = split(/\s+/, $line, 2);
next if !$conf->{force} and $exclude->{$file}; # ignore user excluded files
next if exists $FILES->{$file} and $md5 eq $FILES->{$file}; # files match, do not update
next if scalar @{$conf->{files}} and !exists $selectfiles->{$file}; # file does not exist and we're not updating select files
push(@updated, $file);
}
# STEP 2: send the update request filelist
my $output = '';
foreach my $f (@updated) {
$output .= exists $FILES->{$f} ? $FILES->{$f} : '0' x 32;
$output .= " " . $f;
$output .= EOL;
}
$srv->sendmsg($output);
if (my ($code, $msg) = $srv->getack) { # wait for ACK packet
logerror("Server Error: $msg",1) if !$code; # die due to server error (FALSE code returned)
}
} else {
logerror("Server did not respond to request.",1);
}
# At this point we've sent our list of files that we want to check for updates
# Now we wait for another response from the server informing us how many of those files need to be updated
if (my ($code, $msg) = $srv->getack) { # wait for ACK packet
logerror("Server Error: $msg",1) if !$code; # die due to server error (FALSE code returned)
# print STDERR "OK\n";
my ($updated, $totalfiles, $bytes, $sizeoflist, $input, $list);
if ($msg =~ /^(\d+)\s+(\d+)\s+(\d+)/) {
($totalfiles, $bytes, $sizeoflist) = ($1,$2,$3);
} else {
logerror("Improper response from server. Aborting. ($msg)\n",1) if !$code;
}
if (!$totalfiles) {
print STDERR "No software updates are available.\n";
exit;
}
if (defined($input = $srv->getmsg)) {
$input = trim($input);
foreach my $line (split(EOL, $input)) { # parse apart updated file list
my ($md5, $file) = split(/\s+/, $line, 2);
$updated->{$file} = $md5;
}
my $prefix = "Updated files: ";
my $width = length($prefix);
my @keys = sort keys %$updated;
print STDERR $prefix;
for (my $i=0; $i < @keys; $i++) {
my $file = $keys[$i];
if (length($file) + 2 + $width > $SCREENWIDTH) { # start a new line if we're over the edge
print STDERR "\n";
$width = 0;
}
print STDERR $file;
$width += length($file) + 2;
print STDERR ", " if $i+1 < @keys;
}
print STDERR "\n";
print STDERR "$totalfiles files have updates available. " . abbrnum($bytes,2) . " will be downloaded.\n";
print "Do you want to download these updates?";
print " YES (auto)\n" if $conf->{yes};
if ($conf->{yes} or yesno(1,1)) {
$srv->sendmsg("1");
for (my $i=0; $i < $totalfiles; $i++) {
if (!getfile($srv)) {
print STDERR "File download aborted due to server error.\n";
}
}
} else {
$srv->sendmsg("0");
print STDERR "No updates will be downloaded. Exiting Now.\n";
exit();
}
} else {
logerror("Server did not respond with updated file list.",1);
}
} else {
logerror("Server did not respond after sending file list.",1);
}
# -------------------------------------------------------------------------
sub trim {
my ($str) = @_;
return $str unless defined $str;
$str =~ s/^\s+//;
$str =~ s/\s+$//;
return $str;
}
# -------------------------------------------------------------------------
sub getfile {
my ($sock) = @_;
my $buffer = '';
my $total = 0;
my $expected = 0;
my $timedout = 0;
my ($msg, $file, $prefix, $ok, $srvmd5, $ourmd5);
($srvmd5, $expected, $file) = split(/\s+/, $srv->getmsg || '');
return 0 if (!defined $srvmd5 or !defined $expected or !defined $file);
$prefix = "\r<<< Downloading $file ";
print STDERR $prefix;
while (!$timedout && $total < $expected) {
if (defined($msg = $sock->getmsg)) {
last unless length($msg);
$total += length($msg);
$buffer .= $msg;
print STDERR $prefix . calcpct($total, $expected, 0) . "%";
} else {
$timedout = 1;
}
}
print STDERR $prefix . calcpct($total, $expected, 0) . "%"; # if !$timedout;
print STDERR "\n";
$ourmd5 = md5_hex($buffer); # must check this BEFORE we convert the file below
# If we're on a Windows platform we need to convert the received file from linux to windows text format
if ($^O eq 'MSWin32' && !isBinary($file)) {
$buffer = lin2win($buffer);
}
$ok = ($total == $expected && $ourmd5 eq $srvmd5); # TRUE if the expected bytes were received and the MD5 matches
if ($ok) {
my $filename = catfile($conf->{path}, $file);
my $dir = (fileparse($filename))[1];
eval { mkpath($dir) unless -d $dir };
if (open(F, ">$filename")) {
binmode(F);
print F $buffer;
close(F);
print STDERR " Updated Successfully: $file\n";
} else {
logerror("Error writting to file: $file: $!",0);
}
} else {
my $err = "";
$err .= "did not receive entire file" if $total != $expected;
$err .= ($err ? ' and ' : '') . "MD5 Checksum does not match $ourmd5 != $srvmd5" if $ourmd5 ne $srvmd5;
logerror($err, 1);
}
$sock->sendmsg($ok);
return $ok;
}
# -------------------------------------------------------------------------
# loads file information for all files within the specified directory
sub gatherFiles {
my ($path) = @_;
my $files = [];
my $d = new IO::Dir($path);
logerror("Error reading '$path' to gather file structure: $!",1) if !defined $d;
if (!@{$conf->{files}}) {
while (defined(my $file = $d->read)) {
next if $file =~ /^\./;
my $fullfile = catfile($path, $file);
if (-d $fullfile) {
push(@$files, gatherFiles($fullfile));
} else {
push(@$files, $fullfile);
}
}
$d->close;
} else {
foreach my $file (@{$conf->{files}}) {
next if $file =~ /^\./;
my $fullfile = catfile($path, $file);
push(@$files, $fullfile);
}
}
return wantarray ? @$files : $files;
}
# -------------------------------------------------------------------------
sub initSocket {
my $sock = IO::Socket::INET->new(
PeerAddr => $conf->{ip},
PeerPort => $conf->{port},
Type => SOCK_STREAM,
Proto => 'tcp',
) or logerror("$@\n",1);
# ) or logerror("Error connecting to $conf->{server} [$conf->{ip}]:$conf->{port}: $@\n",1);
$sock->autoflush(1);
return $sock;
}
# -------------------------------------------------------------------------
sub showusage {
my ($versiononly) = @_;
print "PsychoPatch v$VERSION\n";
exit if $versiononly;
print "\n";
exit;
}
# ------------------------------------------------
# converts text from WINDOWS to LINUX format
sub win2lin {
my ($str) = @_;
$str =~ s/\x0D\x0A/\x0A/g;
return $str;
}
# ------------------------------------------------
# converts text from LINUX to WINDOWS format
sub lin2win {
my ($str) = @_;
$str =~ s/\x0A/\x0D\x0A/g;
return $str;
}
# ------------------------------------------------
sub prompt_password {
my $pw = '';
print "Note: Your password will not be displayed as you type it below.\n" if $READKEY;
print "Password: ";
if ($READKEY) {
Term::ReadKey::ReadMode('noecho');
$pw = Term::ReadKey::ReadLine(0);
Term::ReadKey::ReadMode('normal');
print "\n";
} else {
chomp($pw = <>);
}
return $pw;
}
# ------------------------------------------------
sub GetOptions_callback {
$parms->{files} = [] unless ref $parms->{files} eq 'ARRAY';
push(@{$parms->{files}}, shift); # add supposed filename from command line to our update list
}
See more files for this project here