#!/usr/bin/perl -wT
# DON"T FORGET TO SET THE PATH!
#
##############################################################################
# Random Image: A random image display script
# Copyright (C) 2002 Larry Boyd
# dmag_designs@dmag.org
#
# 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.
#
##############################################################################
# random_image 2.0
$|= 1;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use strict;
use vars qw(%img_type);
#################
# Configuration #
#################
# absolute path to your starting point only directories below this can be used
my $base_path = "/kunden/87829_71640/webseiten/roundafrica/";
# base URL to your images. DON'T put the trailing "/"
my $image_url = "http://www.roundafrica.de";
###################
## error messages #
###################
## Error Code 1: Missing directory
my $e1 = "
Error code: 1I'm sorry, but I am unable to complete your request. Please contact the page administrator and provide the error code listed above.
";
## Error Code 2: Someone tried to use a / or .. in the start of a $path or $directory var
my $e2 = "Error code: 2I'm sorry, but I am unable to complete your request. Please contact the page administrator and provide the error code listed above.
";
##############
# here we go #
##############
my @ls = '';
my $method = param('method');
my $path = param('path');
my $alt_txt = param('alt_txt');
my $link = param('link');
# let's do some checks on the the supplied path to make sure
# someone doesn't try to do anything tricky
# make sure the parameters are there so the default directories don't get shown
if (!$path) {
&print_error($e1);
} # end if
# check to see if $path starts with a / or \ and error if they do
if ($path =~ /^\//) {
&print_error($e2);
} # end if
if ($path =~ /^\\/) {
&print_error($e2);
} # end if
# make sure we don't allow any tricky stuff using ".." or "."
if ((index $path, "..") != -1) {
&print_error($e2);
} # end if
if ((index $path, ".") != -1) {
&print_error($e2);
} # end if
my $file_dir = "$base_path" . "$path/";
# open the directory and output the files
opendir(FILES,"$file_dir") or die "Couldn't open directory $file_dir for reading!";
my @allfiles = grep(!/^\.\.?$/,readdir(FILES));
srand();
closedir(FILES);
my $nlines=@allfiles;
my $file = int(rand(@ls));
my $img_file = $allfiles[int rand $nlines];
if ($method eq 'ssi') {
if (!$link) {
print "Content-type: text/html \n\n";
print "";
} # end if
else {
print "Content-type: text/html \n\n";
print "";
} # end else
exit;
} # end if
else {
my %img_type = ("jpg","jpeg", "jpeg","jpeg", "gif","gif", "png","png", "bmp","bmp", "tif","tiff", "tiff","tiff");
my $ext = '';
($ext) = $img_file =~ /\.([^.]+)$/;
$ext = lc($ext);
my $type = $img_type{"$ext"};
open IMG, "$file_dir/$img_file"
or die "Image \"$file_dir/$img_file\" not found ";
binmode IMG;
undef $/;
my $img = ;
close IMG;
print "Content-Type: image/$type\r\n\r\n";
binmode STDOUT;
print STDOUT $img;
} # end else
###################################################################################
# print_error: subroutine to output error messages. Useful for debugging as well. #
###################################################################################
sub print_error {
my $error = shift;
print "content-type: text/html \n\n";
print "$error
";
exit(0);
} # end sub print_error