Graphics Check

#!/usr/local/bin/perl

#############################################################################
#                                                                           #
# GraphicsCheck                     Version 1.0                             #
# Written by Craig A. Patchett      craig@patchett.com                      #
# Created 8/26/96                   Last Modified 8/26/96                   #
#                                                                           #
# Part of the CGI/Perl Cookbook (John Wiley & Sons, 1996)                   #
# Copyright 1996 Craig Patchett & Matthew Wright.  All Rights Reserved.     #
#                                                                           #
# This script is bookware: if you use the script, buy the book. :-)         #
#                                                                           #
#############################################################################


#############################################################################
# Define configuration constants                                            #
#############################################################################

# $BASE_URL is the URL for the directory in which the graphic files are kept
# Note: The URL must end with a '/' character.

$BASE_URL = 'http://www.patchett.com/gctest/';

# $GRAPHICS_URL is the URL for the page to show if graphics are supported

$GRAPHICS_URL = 'http://www.patchett.com/gctest/gcgraphics.html';

# $TEXT_URL is the URL for the page to show if graphics are not supported

$TEXT_URL = 'http://www.patchett.com/gctest/gctext.html';

# $TMP_DIR is the full path to the directory in which temporary files will
# be created for each visitor to the page. Note that this directory may need
# to be cleaned out periodically.
# Note: This path must end with a directory delimiter ('/' for UNIX & PC, 
# ':' for Mac)

$TMP_DIR =  '/users/cpatch/gctest/';


#############################################################################
# If there's no PATH_INFO then redirect to the appropriate page             #
#############################################################################

if (!($ENV{'PATH_INFO'})) {

    # Convert IP to filename (for 8-character filename compatibility) and
    # redirect based on whether or not a file named $filename exists
    # Note: UNIX and Mac users can use $ENV{'REMOTE_ADDR'} for $filename
    # without calling &ip_convert if they want more meaningful filenames
    
    if ($filename = &ip_convert($ENV{'REMOTE_ADDR'})) {
        $file_path = "$TMP_DIR$filename";
        if (-e $file_path) {
            unlink($file_path);
            print "Location:$GRAPHICS_URL\n\n";
        }
        else { print "Location:$TEXT_URL\n\n" }
    }
    else { print "Location:$GRAPHICS_URL\n\n" }
}
        
        
#############################################################################
# Otherwise create temp file and redirect                                   #
#############################################################################

else {
    $page_name = substr($ENV{'PATH_INFO'}, 1);

    # Convert IP to filename (for 8-character filename compatibility) and
    # create temp file
    
    $filename = &ip_convert($ENV{'REMOTE_ADDR'});
    
    if ($filename) {
        $file_path = "$TMP_DIR$filename";
        open(FLAG, ">$file_path") || &error("Check the permissions for $TMP_DIR ($!).");
    }
    print "Location:$BASE_URL$page_name\n\n";
}


### Subroutine:    &ip_convert()
###
### Function:      Converts an IP address in string form to an eight-byte string
###
### Usage:         &ip_convert($ip);
###
### Variables:     $ip --  string containing IP address 
###                Example: "204.210.193.97"
###
### Returns:       String containing eight-byte encoded IP address (in base64 format)
###                Null string if $ip is null
###
###                Note: No error checking is done on $ip
###
### Uses Globals:  None
###
### Files Created: None

sub ip_convert {

    local($ip) = $_[0];
    if (!ip) { return }
    else {
    
        # Convert $ip into four-byte string
        
        $ip = pack("C4", split(/\./, $ip));
        
        # Convert string into uuencoded
        
        $ip = substr(pack("u", $ip), 1);
        
        # Convert uuencoded into base64
        
        chop($ip);
        $ip =~ tr| -_`|A-Za-z0-9+/A|;
    }
    $ip;
}

### Subroutine:    &error()
###
### Function:      Prints a simple error message HTML page to STDOUT
###
### Usage:         &error([$error_msg, $page_title, $bg_color, $bg_image]);
###
### Variables:     $error_msg --  Error message 
###                               Defaults to "Sorry, an unexpected error occurred."
###                $page_title -- Title for HTML page
###                               Defaults to "Unexpected Error"
###                $bg_color --   HTML background color
###                               Defaults to "#FFFFFF" (white)
###                $bg_image --   URL for background image file 
###                               Example: "http://www.here.com/image.gif"
###
###                Note: All arguments are optional but values for all prior arguments
###                      must be included (even if left undefined or '') if a given
###                      argument is used.
###
### Returns:       Does not return. Calling this subroutine ends the script
###
### Uses Globals:  $ERROR_LINK -- URL to link to for error feedback
###                               Example: "mailto:someone@somewhere.com"
###                $ERROR_LINK_TEXT -- Text that should be linked to $ERROR_LINK
###                               Example: "Click here to report this error."
###
### Files Created: None, but an HTML error page is printed to STDOUT

sub error {

    # Get the arguments, set defaults if arguments missing
    
    local($error_msg, $page_title, $bg_color, $bg_image) = @_;
    $error_msg = 'Sorry, an unexpected error occurred.' if !$error_msg;
    $page_title = 'Unexpected Error' if !$page_title;
    $bg_color = '#FFFFFF' if !$bg_color;
    
    # Print the MIME header
    
    print "Content-type: text/html\n\n";

    # Print the HTML header and start the body block
    print <<"END";
<HTML>
    <HEAD>
        <TITLE>$page_title</TITLE>
    </HEAD>
END
    
    # Print the background info
    
    print "<BODY BGCOLOR=\"$bg_color\"";
    if ($bg_image =~ m|http://.*\..*|) { 
        print " BACKGROUND=\"$bg_image\">\n";
    }
    else { print ">\n" }
    
    # Print the rest of the page
    
    print <<"END";
        <CENTER>
        <H1>$page_title</H1>
        <P>
        <H3>$error_msg</H3>
        <P>
        <A HREF=\"$ERROR_LINK\">$ERROR_LINK_TEXT</A>
    </BODY>
</HTML>
END
    die $error_msg;
}