#! /usr/bin/perl -w # --------------------------------------------------------------------- # Program for downloading XPlanet cloud images from a random mirror # # Copyright (c) 2003, cueSim Ltd. http://www.cueSim.com, Bedford, UK # # Modified by Matthew Gates, 2006 # - added further checks on bad files. # - added md5 checker for known "downloading" images. # - added perl -w option and made modifications necessary to # take advantage of the safety provided by it. # - added command line processing # - changed variable naming convension to match my own preferences # - added POD documentation # # --------------------------------------------------------------------- # # # Redistribution and use, with or without modification, are permitted # provided that the following conditions are met: # # * Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # # * Neither the cueSim name nor the names of its contributors may # be used to endorse or promote products derived from this software # without specific prior written permission. # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # AS IS AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE # COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED # OF THE POSSIBILITY OF SUCH DAMAGE. use constant PROG_DESCRIPTION => "XPlanet Cloudmap Downloader"; use constant PROG_COPYRIGHT => "Copyright (c) 2003, cueSim Ltd."; use constant PROG_VERSION => "0.01"; use constant PROG_AUTHOR => "cueSim Ltd ; modified by Matthew Gates"; use strict; use LWP::Simple; use Digest::MD5; use Getopt::Long; use File::Basename; # Presets & defaults my @ga_mirrors = ( "ftp://mirror.pacific.net.au/pub2/xplanet/clouds_2048.jpg", "http://xplanet.fortha.org/clouds_2048.jpg", "http://www.ruwenzori.net/earth/clouds_2048.jpg", "http://xplanet.dyndns.org/clouds/clouds_2048.jpg", "http://userpage.fu-berlin.de/~jml/clouds_2048.jpg", "http://rcswww.urz.tu-dresden.de/~es179238/clouds_2048.jpg", "http://home.megapass.co.kr/~jhkim1101/cloud_data/clouds_2048.jpg", "http://user.chol.com/~winxplanet/cloud_data/clouds_2048.jpg", "http://home.megapass.co.kr/~gitto88/cloud_data/clouds_2048.jpg", "http://myhome.hanafos.com/~hyoungkee/cloud_data/clouds_2048.jpg", "http://giga.forfun.net/clouds_2048.jpg", "http://php.nctu.edu.tw/~ijliao/clouds_2048.jpg", # # "http://www.wizabit.eclipse.co.uk/xplanet/files/mirror/clouds_2048.jpg", "http://www.wizabit.eclipse.co.uk/xplanet/files/local/clouds_2048.jpg", "ftp://ftp.iastate.edu/pub/xplanet/clouds_2048.jpg", "http://enekoalonso.com/projects/xplanet/clouds_2048.php", "http://xplanet.nerp.net/clouds_2048.php"); my $gs_debug = 0; my $gs_overwrite = 0; my $gs_xp_dir = "$ENV{HOME}/.xplanet"; my $gs_cloud_file = "clouds.jpg"; my $gs_hours = 2; my $gs_retries = 6; my $gs_thisscript = basename($0); # Process command line options GetOptions( 'debug=i' => \$gs_debug, 'filename=s' => \$gs_cloud_file, 'force' => \$gs_overwrite, 'help' => \&usage, 'hours=i' => \$gs_hours, 'list-mirrors' => \&list_mirrors, 'output-directory=s' => \$gs_xp_dir, 'retries=i' => \$gs_retries, 'version' => sub { print &PROG_DESCRIPTION . " by " . &PROG_AUTHOR . "\n" . "version " . &PROG_VERSION . "\n" . &PROG_COPYRIGHT . "\n"; }, ) || usage(1); # Change to directory where we'll put the output file chdir "$gs_xp_dir" || die "cannot change dir to $gs_xp_dir : $!\n"; # Get file details if( -f $gs_cloud_file ) { my @stat_info = stat($gs_cloud_file); my $file_age = (time() - $stat_info[9]); my $file_size = $stat_info[7]; # Check if file is already up to date if ( ( $file_age < 60 * 60 * $gs_hours && $file_size > 2048) && ! $gs_overwrite ) { db_out(3,"$gs_cloud_file is already up to date"); exit(1); } } # Try several times to download the file if necessary for(1..$gs_retries) { # Get a random website to hit for the file my $mirror_url = get_random_mirror(); # Download the file db_out(2,"downloading from $mirror_url"); my $response = getstore($mirror_url, $gs_cloud_file); # If successfully downloaded, that's it, nothing more to do if( indicate_success($response) ) { my $size = (stat($gs_cloud_file))[7]; db_out(2,"successfully downloaded $gs_cloud_file (size=$size)"); exit(0); } # Warning that we're retrying another random server db_out(1,"download FAILED from $mirror_url"); } # Warning that no servers could be contacted db_out(-1, "ERROR: tried to download the file $gs_retries times, but no servers could provide the file"); exit(2); # Return codes of 200 to 299 are "success" in HTTP-speak sub indicate_success { # If $gs_cloud_file file is not existing or zero bytes, it didn't work if ( ! -e $gs_cloud_file || -z $gs_cloud_file ) { db_out(2, "FAILED to download (non-existing or 0-size file)"); return(0); } # Sometime the file is downloaded but contains an HTML message, despite # getting a success message. In this case the file is very small (115 # bytes is typical). We'll reject any file smaller than 1024 bytes. my $size = (stat($gs_cloud_file))[7]; if ( $size < 1024 ) { db_out(2, "FAILED to download (too small - $size bytes)"); return(0); } if ( check_error_image($gs_cloud_file) ) { db_out(2, "FAILED - image is known error message image"); return(0); } my $response = shift(); if($response =~ /2\d\d/) { db_out(4, "downloaded file looks good"); return(1); } else { db_out(2,"FAILED to download - HTTP error: $response"); return(0); } } # Returns the name of an internet resource which can provide the clouds image sub get_random_mirror { # Return one at random return $ga_mirrors[rand scalar(@ga_mirrors)]; } sub list_mirrors { foreach my $m (@ga_mirrors) { print "$m\n"; } exit(1); } sub check_error_image { # Sometimes the image downloaded is a picture with an error message in it # saying something like the image is being received from the satellite # In this case we want to "fail" the download. It's easy to see, but it's # very difficult to check this programatically, so we keep a list of # checksums of these files and check that way. my $file = shift; my %bad_image_md5s = ( "e0efd0c168fcdeb3d3029cf35ae230a9" => 1, ); if ( ! open(IMG, "<$file") ) { db_out(0, "WARNING: could not open $file to check md5 checksum!"); return(1); } my $md5 = Digest::MD5->new; $md5->addfile(*IMG); close(IMG); db_out(4, "checksum is $md5->hexdigest"); if ( defined($bad_image_md5s{$md5->hexdigest}) ) { db_out(3, "bad checksum identified: $md5->hexdigest"); return(1); } else { db_out(3, "checksum is not a baddun: $md5->hexdigest"); return(0); } } sub db_out { my $lev = shift; return if ( $gs_debug < $lev ); my $message = shift; print STDERR "$gs_thisscript: $message\n"; } sub usage { my $lev = shift || 0; system("pod2usage -verbose 1 $0"); exit($lev); } __END__ =head1 NAME download_xplanet_cloudmap - fetch an xplanet cloudmap =head1 SYNOPSIS download_xplanet_cloudmap [options] =head1 DESCRIPTION download_xplanet_cloudmap tries to connect to one of a few satellite cloudmap servers (choosing which one randomly) and downloads... well, err, a cloudmap. The resulting file is called F, and is put in the F<$HOME/.xplanet> directory. If the output file already exists and is less than two hours old, a new file is not retrieved (this is to prevent swamping servers with inappropriate requests). Because the various servers are somewhat unreliable, the program chooses from the list of known servers randoly, and will re-try failed fetched up to 6 times (choosing a random server from the list each time). =head1 OPTIONS =over =item B<--debug>=I Print diagnostic messages while executing. The value of I must be an integer. The higher the number, the more verbose the diagnostic output will be. =item B<--filename> I Change the output filename from F to I =item B<--force> Don't check to see how old existing fils are - download regardless (see NOTES section about server abuse). =item B<--help> Print the command line syntax an option details. =item B<--hours> I Change the number of hours to wait before getting an image from the default (2) to I. =item B<--list-mirrors> Show a list of mirrors which are known. By the way, to edit the list, you have to edit the program file. =item B<--output-directory> I Change the default output directory from F<$HOME/.xplanet> to I. =item B<--retries> I Change the number of retries from the default (6) to I. =item B<--version> Print the program description and version. =back =head1 ENVIRONMENT =over =item STUFF_?_DBLEVEL Sets debugging levels. The ? can be D for database, M for module, or S for script debugging messages. Generally only S and D are interesting for users, M is mostly just used during development. =back =head1 FILES =over =item filename desc =head1 NOTES Note: excessive requests to a single image server is discouraged. This script limits max retries, does not download more frequently than every two hours (the file is generated every 3 hours). and picks a random mirror location for every download. Change these settings at the risk of being blacklisted from the image servers. =head1 DIAGNOSTICS =over =item 0 Everything was OK, a new image was downloaded correctly. =item 1 Existing image is not old enough to justify a new download so nothing was done. =item 2 Couldn't get a file from any of the mirrors which were tried =back =back =head1 LICENSE Redistribution and use, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Neither the cueSim name nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS AS IS AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =head1 AUTHOR Original version by cueSim Ltd, 2003; http://www.cueSim.com/ Modifications: Matthew Gates; http://porpoisehead.net/ =head1 CHANGELOG =over =item Date:2006-10-29 Bugfixes, MNG Generate md5 properly. =item Date:2006-09-01 Lotsa changes, MNG Added the following features: command line option processing; additional download error checks; pod documentation. =item Date:2003 Original version By cueSim Ltd. =back =head1 BUGS Please report bugs to the author. =head1 SEE ALSO xplanet(1) =cut