#!/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 = "<center><b>Error code: 1<p>I'm sorry, but I am unable to complete your request. Please contact the page administrator and provide the error code listed above.</b></center>";

## Error Code 2: Someone tried to use a / or .. in the start of a $path or $directory var
my $e2 = "<center><b>Error code: 2<p>I'm sorry, but I am unable to complete your request. Please contact the page administrator and provide the error code listed above.</b></center>";

##############
# 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 "<img src=\"$image_url\/$path\/$img_file\" alt=\"$alt_txt\" border=\"0\">";
        } # end if
        else {
                print "Content-type: text/html \n\n";
                print "<a href=\"$link\"><img src=\"$image_url\/$path\/$img_file\" alt=\"$alt_txt\" border=\"0\"></a>";
        } # 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 = <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 "<b>$error</b><br>";
exit(0);
} # end sub print_error