#!/usr/bin/perl -w ############################################################################### # # File: v2html-cgi # RCS: $Header: /home/cc/v2html/RCS/v2html-cgi,v 3.0 1998/05/15 19:11:43 cc Exp $ # Description: CGI script for helping v2html generated html # Author: Costas Calamvokis # Created: Wed Sep 3 08:52:08 1997 # Modified: Sat May 2 15:19:41 1998 (Costas Calamvokis) v2html@iname.com # Language: Perl # # Copyright 1998 Costas Calamvokis # Copyright 1997 Hewlett-Packard Company # # This file nay be copied, modified and distributed only in accordance # with the terms of the limited licence contained in the accompanying # file LICENCE.TXT. # ############################################################################### # # Currently does: # Expanding/compressing hierarchies: # - Takes a query like ?k=9437645&x=XXXXCCXC&in=hierarchy.html # and generates html of the hierarchy in in accoring to the string # x, each character in the string x represents one list in the .html # file which can either be eXpanded or Compressed. # - After each module it also generates a [X] or [C] link which when # clicked causes this script to be called again with a new string # which results in that module being expanded or compressed. # - This is made much easier by v2html which marks each list that is # with a candidate for expansion/compression with a # number when it generates the html code. # # only have one file error message to avoid leaking information # through errors (uncomment the helpful error during debugging) $file_error_message= "v2html-cgi error.
\n";
print "Content-Type: text/html\n\n";
# environment variables that should be set by the web server
&check_input(%ENV,'QUERY_STRING');
&check_input(%ENV,'SCRIPT_NAME');
&check_input(%ENV,'PATH_INFO');
&check_input(%ENV,'PATH_TRANSLATED');
# Get the arguements specified in the URL
%args= getcgivars();
# query variables that should be set in the URL
# (eg .. ?k=9999x=CXCX&in=hierarchy.html
&check_input(%args,'x');
&check_input(%args,'f');
&check_input(%args,'in');
&check_input(%args,'k');
$k = $args{'k'};
$expand_string =$args{'x'};
$infile = $args{'in'};
$framed = $args{'f'};
# remove the / from script name if it is there
$ENV{'SCRIPT_NAME'} =~ s#^/## ;
# set up the cgi script and path info that we'll put in the expand/compress
# links
$cgi_script_and_path_info= "/" . $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'};
$marker = " ";
$printing=1; # start out printing the file
$ul_id=0;
# Work out the hierarchy file to read
$file=$ENV{'PATH_TRANSLATED'} . $infile;
# Remove any .. in the file name so people can't look at files
# that are not under the web root
$file=~ s/\.\.//g;
# open the hierarchy file
unless (open(F,"<$file")) {
print $file_error_message;
# this less cryptic message could give intruders clues about your files
#print "Couldn't open $ENV{'PATH_TRANSLATED'}$infile\n";
exit;
}
# check that the hierarchy file starts with ";
&security_check_hierarchy($_);
# Have a look for the briefcase icons - if they don't exist
# use [C] and [X]
&find_icons;
# set up the extra infomation needed to do framed output
if ($framed eq "1") { $target='target="upper"'; }
else { $target=''; }
#
# main loop
#
while ( \n";
if ($s eq 'k') {
print " This may be because the hierarchy was generated\n" .
" by v2html 2.0. If so regenerate using a newer version \n";
}
exit;
}
}
#
# Read all CGI vars into an associative array.
# If multiple input fields have the same name, they are concatenated into
# one array element and delimited with the \0 character.
# This is a simple version, that assumes a request method of GET.
#
sub getcgivars {
local(%in) ;
local($name, $value) ;
# Resolve and unencode name/value pairs into %in
foreach (split('&', $ENV{'QUERY_STRING'})) {
s/\+/ /g ;
($name, $value)= split('=', $_, 2) ;
$name=~ s/%(..)/sprintf("%c",hex($1))/ge ;
$value=~ s/%(..)/sprintf("%c",hex($1))/ge ;
$in{$name}.= "\0" if defined($in{$name}) ; # concatenate multiple vars
$in{$name}.= $value ;
}
return %in ;
}
#
# Do security checks on the hierarchy file
# make sure we don't:
# serve files that are not v2html hierarchies
# serve files that users can't get access to through the http demon
# (by checking that the key is right)
#
sub security_check_hierarchy {
my ($first_line) = @_;
if ($first_line =~ /^ &) {
if (&check_expand_string($1)) {
# This is expanded now, so print compressor
print $marker .
"\n";
print $marker .
" $icon_c\n";
# keep printing
print $_;
}
else {
$ul_id=$1;
# This is compressed now, so print expander
print $marker .
"\n";
print $marker .
" $icon_x\n";
# stop printing
$printing=0;
}
}
else {
# print everything else except compressors and expanders
# which are generated fresh each time
if (! m/$marker/) {
print $_;
}
}
}
else {
# not printing, look for the end of the ul_id which stopped the
# print.
if (m&
&) {
$printing=1;
}
}
}
exit;
###########################################################################
# Subroutines
###########################################################################
#
# Takes one arguement - the number in the character string to
# look at.
# Returns 1 if the list is expanded and 0 if it is compressed
# if the number is off the end of the expand string then it
# returns 1
#
sub check_expand_string {
local($u) = @_;
local($c);
if ($expand_string eq 'A') {
return 1;
}
elsif (length($expand_string)>$u) {
$c = substr($expand_string,$u,1);
if ($c eq 'X'){
return 1;
}
else {
return 0;
}
}
else {
return 0;
}
}
#
# Generate a new expand_string for a compressor or an expander link
# Takes two arguments, the number of the list and the new character
# to put in ('C' for compressor, 'X' for expander)
#
sub new_expand_string {
local($u,$c) = @_;
local($new_string,$l);
$l = length($expand_string);
if ($l > $u) {
$new_string = $expand_string;
substr($new_string,$u,1) = $c;
}
else {
if ($expand_string eq "A") {
$new_string = "X" . "X" x ($u-$l) . $c;
}
else {
$new_string = $expand_string . "C" x ($u-$l) . $c;
}
}
return $new_string;
}
#
# check that the input array %a has an element $s
#
sub check_input {
local(%a,$s) = @_;
if (!exists($a{$s})) {
print "v2html-cgi: fatal error, didn't get required parameter $s.