Is this secure

[Rednecktek]

I've been asked if this script is secure. I believe it is. Can anyone find
any problems with it?

#!/usr/bin/perl -w -t
use strict;
use Apache;
$ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl/ or die "GATEWAY_INTERFACE not Perl!";
my $r = Apache->request();
my %args = $r->args();
my $path = $r->uri;

############################################################################
###
$path  =~ s/\/(.*?)$//; # Strip off the scriptname
my $tmplpath = "template/";  # Setup the template path
my $cont_ext = ".html";  # Allow only content files with this extension
my $tmpl_ext = ".tmpl";  # Allow only template files with this extension
my $template = $tmplpath ."mcti". $tmpl_ext; # Setup the template path
my $page = $args{page} || "index"; # Are we requesting a page or root?
my $title = "Microdyne";  # Default Title of not specified in page
my $debug = 1;
############################################################################
###
my ($content, $pageout, $newtitle, $newtmpl);

($content, $newtitle, $newtmpl) = pullpage( $page . $cont_ext );
if ($newtitle) {$title = $newtitle;}
if ($newtmpl) {$template = $tmplpath . $newtmpl . $tmpl_ext;}
$pageout = readfile( $template );
$pageout =~ s/%%TITLE%%/$title/g;
$pageout =~ s/%%CONTENT%%/$content/g;

pageout($pageout);

############################################
# Spit out the content
############################################
sub pageout {
    my $pageout = shift;
    $r->content_type('text/html');
    $r->header_out( 'Content-Length', length($pageout) );
    $r->send_http_header();

    my $start = 0;
    my $len = 63000;
    while (my $p = substr($pageout, $start, $len)) {
 $start += $len;
 $r->print($p);
    }
    $r->rflush();
}

############################################
# Open content page, and check for options
# checks for tags in format: %%TAG=VALUE%%
############################################
sub pullpage {
    my $file = shift;
    my ($content, $title, $template);
    $content = readfile( $file );

    while ($content =~ m/%%(.*?)=(.*?)%%/) {
 my $key = $1;
 my $value = $2;
 SWITCH: for ($key) {
     /TEMPLATE/ && do {
  # Override default template
  logit("Found $key - $value",2);
  $template = $value;
  $content =~ s/%%$key=$value%%//g;
  last SWITCH;
     };
     /TITLE/ && do {
  logit("Found $key - $value",2);
  $title = $value;
  $content =~ s/%%$key=$value%%//g;
  last SWITCH;
     };
     /INCLUDE/ && do {
  #Read in an Included file
  logit("Found $key - $value",2);
  my $repl = readfile( $value );
  $content =~ s/%%$key=$value%%/$repl/g;
  last SWITCH;
     };
 };
    }
    return ($content, $title, $template);
}

############################################
# Reads a file and returns the content
############################################
sub readfile {
    my $file = shift;
    my $rv;
    logit("Opening file $file",2);
    open( FILE, $file ) || return "Could not find file $file";
    my @lines = <FILE>;
    close FILE || return "Could not close filehandle";
    logit("Closed file $file",2);
    for (@lines) {
 $rv .= $_;
    }
    return $rv;
}

sub logit {
    my $warning = shift;
    my $level = shift || 1;
    my $caller = (caller(1))[3];
    if ($debug >= $level) {
 warn "    $caller:\t$warning";
    }
}

1;



-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]