Sample Source Code
Proxima: local.pl

About the Program

"Proxima" is a combination HTTP daemon and HTTP proxy server, designed for QuickATM's internet kiosk project. It will run on the servers in each pod of kiosks, providing a clean interface to the web for web surfers -- complete with 'smut' URL blocking, nice error messages, different levels of users (with different URL restrictions), and transaction logging. It was written to be fully compliant with the HTTP/1.0 and CGI/1.1 specifications.

About the Code

This module specifically handles local HTTP requests. Requests are resolved, and, in the case of plain files, serviced. CGI requests are forwarded to another module. The single entry point into this module from the rest of the program is &HandleLocal.

The Code

# ----------------------------------------------------
# 'local.pl'
# Part of the Proxima httpd/proxy server.
# Copyright (c) 1996 by QuickATM, all rights reserved.
# ----------------------------------------------------

# ---------------------------------------------------------------------------

sub HandleLocal {
    # we only operate on two ports.
    if ( ( $remote_port ne $local_port ) && ( $remote_port ne '80' ) ) {
        &ErrorPort;
        return;
    }

    &LogLocal;

    # perform a URL-Decoding on the requested filename.
    $remote_file =~ s/%(..)/pack( "c", hex( $1 ) )/ge;

    # construct the true filename.
    if ( $remote_file =~ /\?/ ) {
        ( $local_orig_file, $local_args ) = split( /\?/, $remote_file, 2 );
    } else {
        $local_orig_file = $remote_file;
        $local_args = "";
    }

    # normalize, remap, etc, the filename.
    $local_file = &NormalizeFilename( $local_orig_file );

    # find out its mime type.
    $local_mime = &MimeType;

    # certain MIME types are disallowed.
    if ( $local_mime ne "CGI" ) {
        if ( &IsBlockedMimeType( $local_mime ) ) {
            &ErrorBlockedMimeType( $local_mime );
            return;
        }
    }

    # HEAD methods.
    if ( $http_method eq "HEAD" ) {
        &HandleLocalHead;
        return;
    }

    # CGI programs.
    if ( $local_mime eq "CGI" ) {
        &HandleCGI;
        return;
    }

    &HandleLocalFile;
}

# ---------------------------------------------------------------------------

sub NormalizeFilename {
    local( $file ) = @_;

    # add a '/' at the front.
    if ( $file !~ /^\// ) { $file = "/$file"; }

    # resolve '.' (/./ and /.$).
    $file =~ s#/\./#/#g;
    $file =~ s#/\.$#/#g;

    # resolve '..' sequences, being careful to cull extras.
    $file =~ s#/([^/.]|[^/][^/.]+)/\.\.(/|$)#/#g;
    $file =~ s#^/\.\.(/|$)#/#g;

    if ( $file =~ /^\/\~/ ) {
        # resolve user home directories.
        local ( $user, $rest, $home );
        ( $user, $rest ) = ( $file =~ /^\/\~([^\/]+)(.*)/ );
        $home = ( getpwnam( $user ) )[ 7 ];
        $file = "$home/$user_home_dir$rest" if ( $home =~ /\S/ );
    } else {
        # indirect the first valid alias mapping we encounter.
        local( $fake, $real );
        foreach $fake ( keys %directory_aliai ) {
            $real = $directory_aliai{ $fake };
            if ( $file =~ /^$fake/ ) {
                $file =~ s/^$fake/$real/;
                last;
            }
        }
    }

    # remove trailing '/' (for directories).
    $file =~ s#/$##;

    # if it's a directory, look for an index file.
    if ( -d $file ) {
        local( $attempt, $good );
        $file .= "/" if ( $file !~ /\/$/ );
        $good = 0;
        foreach $attempt ( @index_files ) {
            if ( -e "$file$attempt" ) {
                $file .= $attempt;
                $good = 1;
                last;
            }
        }
        if ( $good == 0 ) {
            &ErrorNoIndexFile;
            return;
        }
    }

    $_ = $file;
}

# ---------------------------------------------------------------------------

sub HandleLocalHead {
    local( $size, $atime, $mtime, $ctime );

    # note that we can't HEAD cgi scripts.
    if ( $local_mime eq "CGI" ) {
        &Result( 501, "Cannot HEAD CGI Scripts" );
        return;
    }

    # no such file?
    if ( ! -e $local_file ) {
        &Result( 404, "File Not Found" );
        return;
    }

    # cannot read file?
    if ( ! -r $local_file ) {
        &Result( 403, "Permission Denied" );
        return;
    }

    ( $size, $atime, $mtime, $ctime ) = ( stat( $local_file ) )[ 7..10 ];

    &PushResult( 200, "Ok" );
    &PushHeader( "Content-Type",   $local_mime );
    &PushHeader( "Content-Length", $size );
    &SendHeaderToClient;
}

# ---------------------------------------------------------------------------

sub HandleLocalFile {
    local( $size, $atime, $mtime, $ctime );
    local( $date_today, $date_changed );

    # no such file?
    if ( ! -e $local_file ) {
        &ErrorNoFile;
        return;
    }
    if ( ! open( LOCAL, "<$local_file" ) ) {
        &ErrorBadFile;
        return;
    }

    # get statistics about this file.
    ( $size, $atime, $mtime, $ctime ) = ( stat( $local_file ) )[ 7..10 ];

    # date information: today's date, and the last-modified date for this file.
    $date_today   = &HttpDate( time );
    $date_changed = &HttpDate( $mtime );

    # identify ourselves.
    &PushHeader( "Server", $program/$version );
    &PushHeader( "Date",   $date_today );

    # this file might be in the browser's cache already...
    if ( $headers{ "if-modified-since" } =~ /\S/ ) {
        local( $cached, $date_val_cached, $date_val_changed );
        $date_cached = $headers{ "if-modified-since" };
        $date_val_cached  = &DateToComparisonString( $date_cached );
        $date_val_changed = &DateToComparisonString( $date_changed );

        # if the file has not changed since then, return a 304 HTTP code.
        if ( $date_val_changed le $date_val_cached ) {
            &PushStatus( 304, "Document Has Not Changed" );
            &PushHeader( "Last-Modified", $date_changed );
            &SendHeaderToClient;
            return;
        }
    }

    # send out the okay.
    &PushStatus( 200, "Ok" );
    &PushHeader( "Last-Modified", $date_changed );
    &PushHeader( "Content-Type", $local_mime );
    &PushHeader( "Content-Length", $size );
    &SendHeaderToClient;

    # send the file's contents.
    &ResetBody;
    while( <LOCAL> ) {
        &AddToBody( $_ );
    }
    &FlushBody;
    close( LOCAL );
}

# ---------------------------------------------------------------------------

1;

Source code is:
© Copyright 1996, QuickATM. All rights reserved.

Marc Wallace
marc@resume.wallace.net
http://www.wallace.net/marc/resume/