#!/usr/npac/bin/perl

# Genesis Script, Release 1.2
#	Copyright 1997 by Fluid Dynamics
#
# For latest version and help files, visit:
#	http://www.xav.com/scripts/genesis
# __________________________________________________________________



# If you downloaded this script as the "genesis.txt" version, rename 
# it to "genesis.cgi" at some point.

# Set path and URL of the directory which you'll be remotely editing 
# (remember to include the trailing slashes):

	$data_http = 'http://www.foxsden.org/simfanatic/simalliance/';
	$data_path = '/npac/server/foxsden00/sroot/droot/simfanatic/simalliance/';
	$core_data_path = $data_path; # Leave this variable alone.

	# The directory must be made writable (chomd 777 demo)

# Enter the system location of the preferences file:

	$prefs_file = '/npac/server/foxsden00/sroot/droot/simfanatic/simalliance/genesis.dat';

	# We recommend that this preference file be placed within the 
	# writable directory.  That way if no preference file exists, 
	# but the above path is correctly specified, this script will 
	# be able to create one the first time you set your preferences.

# Enter the URL of this script (on some systems you may have to enter 
# the complete, absolute URL; otherwise the default should be fine):

	$cgi_url = 'http://boss.npac.syr.edu:8080/cgi-bin/simalliance/genesis.pl';

	# Remember to make GENESIS executable (chomd 755 genesis.cgi).

# Location of a log file which records the IP address, time, and 
# summary of each transaction (set to '' to disable logging):

	$logfile = '/npac/server/foxsden00/sroot/droot/simfanatic//log.txt';

	# This is a security feature.  Do _not_ place it within the 
	# writable directory.  You will, however, have to make this 
	# file writable (chmod 777 log.txt).

# The next few options should work fine as-is, but you may modify 
# them if you'd like.

# This is the URL to a black gif that is used for quick editing.  Feel 
# free to use ours, but you may have a faster response by moving the 
# image to your own server:

	$black_url = 'http://www.xav.com/scripts/genesis/black.gif';

# Should text files be executable?  Set to 'yes' to make them 
# executable (i.e., they can be working CGI scripts or documents 
# with SSI calls). This is a security risk, so don't set to 'yes' 
# unless you have to.

	$execute = 'no';

	# $execute = 'no' means new files have mode 744.
	# $execute = 'yes' means new files have mode 755.
	# Note that _all_ files created by GENESIS are script 
	# writable, and so data files for scripts do not 
	# require the normal mode 777.

# Size limit (in kilobytes) allowed to the GENESIS user.  This is 
# a required variable; set to something high to effectively remove 
# space restrictions:

	$allowed_space = '10000';

# Maximum size (in kilobytes) of uploaded files.  This is a 
# required variable; set to something high to effectively remove 
# upload restrictions:

	$allowed_upload = '10000';

# Location of the "make directory" command on your system (type 
# "whereis mkdir" at the command line to find out):

	$make = '/bin/mkdir';

# Location of the "remove directory" command on your system (type 
# "whereis rmdir" at the command line to find out):

	$remove = '/bin/rmdir';

# Location of "rename" command on your system (type "whereis mv" 
# at the command line to find out):

	$rename = '/bin/mv';

# These are our tips for using GENESIS.  If you think of some good ones, 
# please let us know so we can add them to future releases.

@tips = ('Make sure to always set your permissions correctly',
	'Use multiple custom templates to make creating documents easy',
	'For best results, use Netscape Navigator 3.0',
	'Place your templates and settings file within your writable directory for easy editing',
	'Use the clickable images and back button for fastest document editing and testing',
	'Try using a standard FTP client when uploading more than ten documents',
	'You can turn off these tips - and do lots more - by clicking on the customize link below',
	'After increasing security, let your visitors upload their own images, sounds, and files with GENESIS',
	'To save space, empty your log file after it reaches 100kb',
	'If you have been coding for more than 36 hours straight, take a break',
	'Write to your parents and grandparents regularly');

# No further editing is necessary, but feel free to play around...
# 
# __________________________________________________________________


# Print the HTML header which goes on every page:
sub start_html
{
srand();
$number_o_tips = @tips;
$tip_number = int(rand($number_o_tips));
$tip = $tips[$tip_number];
print "Content-type: text/html\n\n";
print <<EOM;
<HTML>
<HEAD>
<TITLE>Genesis!</TITLE>
</HEAD>
<BODY BGCOLOR=FFFFFF LINK=CE0000 ALINK=FFFFFF VLINK=CE0000>
<CENTER>
<B><TT><FONT SIZE=+2>Genesis! by Fluid Dynamics</FONT><BR>
[ - <A HREF="$cgi_url">Home Root</A> -
Back to <A HREF="$link_url">$link_title</A> - ]</TT></B>
EOM
if ($show_tips eq 'yes')
	{print "<BR><BR>Tip: $tip<BR><BR></CENTER>\n";}
else
	{print "</CENTER><BR><BR>\n";}
EOM
} # Finished printing the HTML header.


# Now we process the input and determine which sub-procedure to 
# route to:

read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
if ($ENV{'QUERY_STRING'})
	{$buffer = "$buffer\&$ENV{'QUERY_STRING'}";}
@pairs = split(/&/,$buffer);
foreach $pair (@pairs)
	{($name,$value) = split(/=/,$pair);
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	$FORM{$name} = $value;}

# Check for allowed disk space to determine whether we can allow 
# editing or uploads:
sub checkspace
{
$du = `du $core_data_path`;
$du =~ s/\n/ /g;
@terms = split(/\s+/,$du);
$size = @terms;
$used_space = ($terms[$size-2]/2);
$free_space = ($allowed_space - $used_space);
$allowed_upload = $free_space if ($free_space <= $allowed_upload);
$delete_only = 'true' if ($free_space < 30);
} # Finished checking.

if ($FORM{'dirname'})
	{
	$dirname = $FORM{'dirname'};
	$name = $dirname;
	&checkname;
	$data_path = "$data_path$dirname/";
	$data_http = "$data_http$dirname/";
	$cgi = "$cgi_url?\&dirname=$dirname";
	}
else
	{$cgi = "$cgi_url?";}

if (($FORM{'x'}) && ($FORM{'y'}) && ($FORM{'action'} eq 'write'))
	{
	$no_report = 'true';
	&write;
	print "Location: $data_http$filename\n\n";
	exit;
	}

# Finished processing input. Now, switch to the working directory 
# and let the user know where we are:

&load_prefs;
&start_html;
if ($dirname)
	{print "We are working out of the <B><TT>$dirname</TT></B> sub-directory.<BR>\n";}
else
	{print "We are working out of the <B><TT>root</TT></B> directory.<BR>\n";}

# The directory is set and has been reported.  Now figure out which 
# subprocedures to route to:

&checkspace;
$action = $FORM{'action'};
if ($action)
	{
	if ($action eq 'delete')
		{
		&delete;
		&list_files;
		&print_options;
		&end_html;
		}
	elsif ($action eq 'removedir')
		{
		&removedir;
		&list_files;
		&print_options;
		&end_html;
		}
	elsif ($action eq 'rename')
		{
		&rename_file;
		&list_files;
		&print_options;
		&end_html;
		}
	elsif ($action eq 'show_prefs')
		{
		&show_prefs;
		&end_html;
		}
	elsif ($action eq 'save_prefs')
		{
		&save_prefs;
		&list_files;
		&print_options;
		&end_html;
		}
	elsif ($action eq 'abort')
		{
		&report("The file <B><TT>$FORM{'filename'}</TT></B> was untouched.");
		&list_files;
		&print_options;
		&end_html;
		}

	# If the user has gotten this far into the if/else maze, they 
	# are trying to create or edit a file.  First we check to make 
	# sure they have permission to do so:

	elsif ($delete_only eq 'true')
		{
		&delete_only_error;
		&end_html;
		}

	# If they pass this flag, then they can continue with the process:

	elsif ($action eq 'edit')
		{
		&edit;
		&end_html;
		}
	elsif ($action eq 'write')
		{
		&write;
		&list_files;
		&print_options;
		&end_html;
		}
	elsif ($action eq 'upload')
		{
		&upload;
		&list_files;
		&print_options;
		&end_html;
		}
	elsif ($action eq 'makedir')
		{
		&makedir;
		&list_files;
		&print_options;
		&end_html;
		}
	}
else
# No action was specified; this is probably the first visit to 
# the script:
	{
	&report("Listing all files and directories.");
	&list_files;
	&print_options;
	&end_html;
	}
# Finished re-directing to the proper subprocedures.  The script is 
# now finished executing; everything below is a subprocedure.
#
# __________________________________________________________________


# Begin Print Options Procedure:
sub print_options
{
if ($delete_only eq 'true')
	{
print <<EOM;
<BR><BR><BLOCKQUOTE>
<B>You are running out of disk space. Please delete some files before 
creating new ones.</B></BLOCKQUOTE><BR><BR><BR>
EOM
	} # End $delete_only = true.
else
	{ # Add permissions enabled.
print <<EOM;
<P><B><TT><FONT SIZE=+1>Add to this directory:</FONT></TT></B>
<BLOCKQUOTE>

<FORM METHOD=POST ACTION="$cgi">
<INPUT TYPE=HIDDEN NAME="action" VALUE="edit">
<B><TT>New Text Document:<BR></TT></B>
Name: <INPUT TYPE=TEXT NAME="filename"><BR>
\&nbsp; \&nbsp; Select Template: <SELECT NAME="template">
<OPTION VALUE="">- No Template
EOM
foreach $key (sort keys %TEMPLATES)
	{
	print "<OPTION";
	print " SELECTED" if ($selected eq $key);
	print ">$key\n";
	}
print <<EOM;
</SELECT><BR>
<INPUT TYPE=SUBMIT VALUE="Make New Text File"></FORM><BR>

<FORM METHOD=POST ACTION="$cgi\&action=upload" 
ENCTYPE="multipart/form-data">
<B><TT>Upload New Binary File (image, sound, etc):<BR></TT></B>
Name: <INPUT NAME="filename"><BR>
\&nbsp; \&nbsp; File On Your Computer: 
<INPUT NAME="file" TYPE="file"><BR>
\&nbsp; \&nbsp; (Requires Netscape 2.0 or higher. Maximum allowed 
upload is $allowed_upload kb.)<BR>
<INPUT TYPE="submit" VALUE="Upload New Binary File"></FORM><BR>

<FORM METHOD=POST ACTION="$cgi">
<B><TT>New Directory:<BR></TT></B>
<INPUT TYPE=HIDDEN NAME="action" VALUE="makedir">
Name: <INPUT TYPE=TEXT NAME="directory"><BR>
<INPUT TYPE=SUBMIT VALUE="Make New Directory"></FORM><BR><BR>
</BLOCKQUOTE>
<BR>
EOM
} # End Write Permissions Enabled.
} # End Print Options.


# Begin Print HTML Footer:
sub end_html
{
print "<H5 ALIGN=CENTER>\n";
if ($action eq 'show_prefs')
	{print "Thanks for striving for the best results!\n";}
else
	{
	print "For best results, <A HREF=\"$cgi\&action=show_prefs\">";
	print "customize your settings</A>.\n";
	}
print <<EOM;
<HR SIZE=1 NOSHADE WIDTH=50\%>
GENESIS Version 1.2 is Copyright 1997 (freeware) by
<A HREF="http://www.xav.com">Fluid Dynamics</A>.<BR>
Visit the 
<A HREF="http://www.xav.com/scripts/genesis">GENESIS Page</A>
for help files and most recent version.</H5></BODY></HTML>
EOM
} # End Print HTML Footer.


# Begin List Files Procedure:
sub list_files
{
&checkspace;
chdir($data_path);
$du = `du`;
@pairs = split(/\n/,$du);
foreach $pair (@pairs)
	{
	@terms = split(/\s+/,$pair);
	$size = $terms[0];
	@parts = split(/.\//,$terms[1]);
	$SIZE{$parts[1]} = &buffnum($size*500);
	}
$ls = `ls -a`;
@ls = split(/\s+/,$ls);
foreach $temp_file (@ls)
	{
if (($temp_file ne '.') && (($temp_file ne '..') || ($dirname)))
		{
		push(@FILES,$temp_file);
		$temp_size = -s $temp_file;
		$SIZE{$temp_file} = &buffnum($temp_size) unless ($SIZE{$temp_file});
		$SIZE{$temp_file} = &buffnum('') if ($temp_file eq '..');
		$NAME{$temp_file} = 'yes';
		@parts = split(/\./,$temp_file);
		$part_number = @parts;
		$part_number--;
		$file_extension = $parts[$part_number];
		if ($part_number < 1)
			{$TYPE{$temp_file} = "___";}
		else
			{$TYPE{$temp_file} = $file_extension;}
		if (-d $temp_file)
			{$DIR{$temp_file} = 'yes';
			$TYPE{$temp_file} = "---";}
		else
			{$DIR{$temp_file} = 'no';}
		if (-T $temp_file)
			{$TEXT{$temp_file} = 'yes';}
		else
			{$TEXT{$temp_file} = 'no';}
		if ($sort_order eq 'Type')
			{$sort_var = "$TYPE{$temp_file}$temp_file";}
		elsif ($sort_order eq 'Size')
			{$sort_var = "$SIZE{$temp_file}$temp_file";}
		else
			{$sort_var = $temp_file;}
		$SORT_ARRAY{$sort_var} = $temp_file;
		}
	}

$num1 = &buffnum($allowed_space);
$num2 = &buffnum($used_space);
$num3 = &buffnum(($allowed_space-$used_space));

print <<EOM;
</BLOCKQUOTE>
<B>Contents of <A HREF="$data_http">
<FONT COLOR=000000>$data_http</FONT></A></B><BR>
<PRE>Allowed disk space: $num1 kb
  <U> Disk space used: $num2 kb </U>
   Disk space free: $num3 kb</PRE>
<BLOCKQUOTE>
<FORM METHOD=POST ACTION="$cgi">
<INPUT TYPE=HIDDEN NAME="action" VALUE="rename">
<B><TT>$data_path</TT></B>
<TABLE BORDER=0 CELLPADDING=4>
EOM
$files_present = 'no';
foreach $key (sort keys %SORT_ARRAY)
	{
	$rel_filename = $SORT_ARRAY{$key};
	if ($NAME{$rel_filename} eq 'yes')
		{
if ($rel_filename eq '..')
	{$title = "..</FONT></A> [higher level directory]</B>";}
else
	{
$title = "<INPUT TYPE=RADIO NAME=\"name\" VALUE=\"$rel_filename\"> $rel_filename</FONT></A></B>";
$files_present = 'yes';
	}
print <<EOM;
<TR>
<TD><B><A HREF="$data_http$rel_filename"><FONT COLOR=0000FF>$title</TD>
<TD><BR></TD>
<TD><BR></TD><TD ALIGN=RIGHT><TT>$SIZE{$rel_filename} bytes</TT></TD>
<TD><BR></TD>
EOM
if ($TEXT{$rel_filename} eq 'yes')
	{
if ($delete_only eq 'true')
	{print "<TD><BR></TD>\n";}
else
	{print "<TD ALIGN=RIGHT><B><A HREF=\"$cgi\&action=edit\&filename=$rel_filename\">";
	print "<FONT COLOR=00AE00>edit</FONT></A></B></TD>\n";}
print <<EOM;
<TD><B><A HREF="$cgi\&action=delete\&filename=$rel_filename">
<FONT COLOR=FF0000>delete</FONT></A></B></TD></TR>
EOM
	}
elsif ($DIR{$rel_filename} eq 'yes')
	{
	if ($dirname)
		{
		if ($rel_filename ne '..')
			{
			$temp_dir = "$dirname\/$rel_filename";
			$newdir = "$cgi_url?\&dirname=$temp_dir";
			}
		else
			{
			@nest = split(/\//,$dirname);
			$levels = @nest;
			if ($levels == 1)
				{$newdir = "$cgi_url?";}
			else
				{
				$temp_dir = $nest[0];
				$upper = $levels - 1;
				for ($i=1;$i<$upper;$i++)
					{$temp_dir = "$temp_dir/$nest[$i]";}
				$newdir = "$cgi_url?\&dirname=$temp_dir";
				}
			}
		}
	else
		{
		$newdir = "$cgi_url?\&dirname=$rel_filename";
		}
	print "<TD ALIGN=RIGHT><B><A HREF=\"$newdir\">";
	print "<FONT COLOR=000000>chdir</FONT></A></B></TD>";
	if ($rel_filename ne '..')
		{
print "<TD><B><A HREF=\"$cgi\&action=removedir\&directory=$rel_filename\">";
print "<FONT COLOR=FF0000>rmdir</FONT></A></B></TD></TR>";
		}
	else
		{print "<TD ALIGN=RIGHT><BR></TD></TR>";}
	}
else
	{
print "<TD><BR></TD>";
print "<TD><B><A HREF=\"$cgi\&action=delete\&filename=$rel_filename\">";
print "<FONT COLOR=FF0000>delete</FONT></A></B></TD></TR>";
	}
}}
if ($files_present eq 'yes')
{
print <<EOM;
</TABLE>
<BR>
<TT><B>-\&gt;</B></TT>
<INPUT TYPE=TEXT NAME="newname"> <INPUT TYPE=SUBMIT VALUE="Rename 
Selection"></FORM><P>
<B>To rename a file or directory, select the radio button to the 
left of it and enter a new name in the box above. Then click on the 
"Rename Selection" button.<P>
To view a file, click on its highlighted filename (in bold <FONT 
COLOR=0000FF>blue</FONT> for most browsers).<P>To edit a text file 
or switch to a directory, click on the center link (in <FONT 
COLOR=00AE00>green</FONT> or <FONT COLOR=000000>black</FONT>, 
respectively, for most browsers).<P>To delete a file or directory, 
click on the rightmost link (in <FONT COLOR=FF0000>red</FONT> for 
most browsers). Be careful, this script doesn't come with an 
<TT>UNDO</TT> command! Note that a directory must be empty before you 
can delete it.</B></BLOCKQUOTE>
EOM
}
else
	{print "</TABLE>\n</BLOCKQUOTE>\n";}
} # End List Files Procedure.


# Begin Delete File Procedure:
sub delete
{
$filename = $FORM{'filename'};
$name = $filename;
&checkname;
$abs_name = "$data_path$filename";
if (-e $abs_name)
	{
	unlink("$abs_name");
	if (-e $abs_name)
		{&report("The file <B><TT>$filename</TT></B> was <B>not</B> deleted, because it is too powerful.");}
	else
		{&report("The file <B><TT>$filename</TT></B> is no longer with us.");}
	}
else
	{&report("The file <B><TT>$filename</TT></B> was not found on this system.");}
} # End Delete File Procedure.


# Begin Edit Text File Procedure:
sub edit
{
$filename = $FORM{'filename'};
$name = $filename;
&checkname;
$absfile = "$data_path$filename";
if ($FORM{'template'})
	{
	$temp_file = $TEMPLATES{$FORM{'template'}};
	}
if (-e $absfile)
	{
	open(FILE,"$absfile");
	@LINES = <FILE>;
	close(FILE);
	$new = 'no';
	}
elsif (($temp_file ne '') && (-e $temp_file))
	{
	open(FILE,"$temp_file");
	@LINES = <FILE>;
	close(FILE);
	$new = 'yes';
	}
else
	{
	@LINES = '';
	$new = 'yes';
	}
if ($new eq 'yes')
	{print "<BR>This is a new file. Input your text below:<P>\n";}
else
	{
	print "<BR>Modify <A HREF=\"$data_http$filename\">";
	print "<B>$filename</B></A> as needed:<P>\n";
	}
$how_many_picts = int($rows/6);
if ($how_many_picts == 0)
	{$how_many_picts++;}
print <<EOM;
<BLOCKQUOTE>
After editing, either click on the black images to the left to save and 
preview <B>$filename</B>, or select "Save Document" to save and return to 
the main <B><TT>GENESIS</TT></B> menu.</BLOCKQUOTE>
<FORM METHOD=POST ACTION="$cgi">
<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
<TR>
<TD VALIGN=MIDDLE>
EOM
for ($i=0;$i<$how_many_picts;$i++)
	{print "<INPUT TYPE=IMAGE SRC=\"$black_url\" BORDER=0><BR>\n";}
print "</TD><TD ALIGN=LEFT VALIGN=TOP>\n";
print "<TEXTAREA NAME=\"file\" ROWS=$rows COLS=$cols>";
$alias = "-AREA";
$alias = "TEXT$alias";
foreach $LINE (@LINES)
	{
	$LINE =~ s/<\/TEXTAREA/<\/$alias/ig;
	print $LINE;
	}
print "</TEXTAREA></TD></TR></TABLE>\n";
print <<EOM;
Alternate Filename:
<INPUT TYPE=TEXT NAME="filename" VALUE="$filename"><BR>
(entering an alternate filename will leave <B><TT>$filename</TT></B> 
untouched and will place the text above into a file with the 
alternate name. Note that if a file already exists with the alternate 
filename, you will overwrite it completely.)<P>
<INPUT TYPE=HIDDEN NAME="action" VALUE="write">
<INPUT TYPE=SUBMIT VALUE="Save Document"></FORM>
<FORM METHOD=POST ACTION="$cgi">
<INPUT TYPE=HIDDEN NAME="action" VALUE="abort">
<INPUT TYPE=HIDDEN NAME="filename" VALUE="$filename">
<INPUT TYPE=SUBMIT VALUE="Abort!!  Don't Change This File"></FORM>
</BLOCKQUOTE><BR><BR>
EOM
} # End Edit Text File Procedure.


# Begin Write Text File Procedure:
sub write
{
$filename = $FORM{'filename'};
$name = $filename;
&checkname;
$new = 'yes';
$absname = "$data_path$filename";
if (-e $absname)
	{$new = 'no';}
$FORM{'file'} =~ s/\cM\n/\n/g;
$alias = "-AREA";
$alias = "TEXT$alias";
$FORM{'file'} =~ s/<\/$alias/<\/TEXTAREA/ig;
open(FILE,">$data_path$filename");
print FILE "$FORM{'file'}";
close(FILE);
if ($execute eq 'yes')
	{chmod(0755,"$data_path/$filename");}
else
	{chmod(0744,"$data_path/$filename");}
&check_creation($absname);
if (($new eq 'yes') && ($no_report ne 'true'))
	{&report("The file <B><TT>$filename</TT></B> has been created.");}
elsif ($no_report ne 'true')
	{&report("The file <B><TT>$filename</TT></B> has been edited.");}
} # End Write Text File Procedure.


# Begin Error Report for Bad File Name:
# Accepts "name" and makes sure that is has all alpha-numerics or 
# -,_, single periods, or internally placed single forward slashes.
# If "name" is invalid, it prints reason and exits.
sub checkname
{
$error = 'false';
@chars = split(//,$name);
$size = @chars;
if ($size == 0)
	{
	$missing_name = 'true';
	$error = 'true';
	}
if ($name =~ /\.\./)
	{
	$double_period = 'true';
	$error = 'true';
	}
if ($name =~ /\/\//)
	{
	$double_slash = 'true';
	$error = 'true';
	}
$character = "";
foreach $char (@chars)
	{
	if (!($char =~ /[A-Z,a-z,'_',\/,\-,0-9,\.]/))
		{
		$forbidden_character = 'true';
		if ($character)
			{$character = "$character, $char";}
		else
			{$character = $char;}
		$error = 'true';
		}
	}
if ($chars[0] eq '/')
	{
	$initial_slash = 'true';
	$error = 'true';
	}
if ($error eq 'true')
{
print <<EOM;
</BLOCKQUOTE>
<H2><TT>Name not accepted</TT></H2>
<BLOCKQUOTE>
The name you entered, <B><TT>$name</TT></B>, doesn't make sense to 
the script. Try entering a name which consists of only the letters 
A through Z (any case), digits 0 through 9, underscores, 
internally-placed single forward slashes, and single periods.<P>
Specifically, the following errors were reported:<P><UL>
EOM
if ($missing_name eq 'true')
	{print "<LI> No file or directory name was offered.<BR>\n";}
if ($initial_slash eq 'true')
	{
	print "<LI> A forward slash was detected as the first ";
	print "character.<BR>\n";
	}
if ($forbidden_character eq 'true')
	{
	print "<LI> The character(s) <B><TT>$character</TT></B> is ";
	print "(are) forbidden.<BR>\n";
	}
if ($double_period eq 'true')
	{print "<LI> Two periods were found side by side.<BR>\n";}
if ($double_slash eq 'true')
	{print "<LI> Two forward slashes were found side by side.<BR>\n";}
print "</UL></BLOCKQUOTE>\n";
&end_html;
exit;
}
} # Finish Error Report for Bad File Name.


# Begin Upload File Procedure:
#	This procedure was borrowed from Jeff Carnahan of Terminal Productions.
#	(http://www.terminalp.com)  Many thanks!
sub upload
{
$| = 1;
$buffer =~ /^(.+)\r\n/;
$bound = $1;
@pairs = split(/$bound/,$buffer);
@var = split(/\r\n/,$pairs[1]);
$filename = $var[3];
$name = $filename;
&checkname;
if ($pairs[2] =~ /Content-Type:/)
	{
$pairs[2] =~ s/^\r\n.+filename.+[^\w\.\%-]([\w\.\%-]+)"\r\n(.*\r\n)\r\n//;
$pairs[2] =~ s/\r\n$//;
	}
else
	{
	@var = split(/\r\n/,$pairs[2]);
	$pairs[2] = $var[3];
	}
open(OUTPUT,">$data_path/$filename");
print OUTPUT $pairs[2];
close(OUTPUT);
$absolute_filename = "$data_path$filename";
$filesize = -s $absolute_filename;
if ($filesize > ($allowed_upload * 1000))
	{
unlink("$absolute_filename");
&report("The file <B><TT>$filename</TT></B> was not uploaded because its size exceeded the limit of $allowed_upload kb.");
	}
else
	{
	&check_creation($absolute_filename);
&report("The file <B><TT>$filename</TT></B> has been uploaded.");
	}
if ($execute eq 'yes')
	{chmod(0755,"$data_path/$filename");}
else
	{chmod(0744,"$data_path/$filename");}
} # End Upload File Procedure.


# Begin Make Directory Procedure:
sub makedir
{
$reldir = $FORM{'directory'};
$absdir = "$data_path$reldir";
if (-e $absdir)
	{
	&report("The directory <B><TT>$absdir</TT></B> already exists.");
	}
else
{
$name = $reldir;
&checkname;
open(NEWDIR,"|$make $absdir");
print NEWDIR $absdir;
close(NEWDIR); 
if ($execute eq 'yes')
	{chmod(0755,"$absdir");}
else
	{chmod(0744,"$absdir");}
&check_creation($absdir);
&report("The directory <B><TT>$reldir</TT></B> has been created.");
}
} # End Make Directory Procedure.


# Begin Remove Directory Procedure:
sub removedir
{
$reldir = $FORM{'directory'};
$name = $reldir;
&checkname;
$absdir = "$data_path$reldir";
open(OLDDIR,"|$remove $absdir");
print OLDDIR $absdir;
close(OLDDIR);
if (-e $absdir)
	{
&report("The directory <B><TT>$absdir</TT></B> was <B>not</B> removed, probably because it isn't empty.");
	}
else
	{&report("The directory <B><TT>$absdir</TT></B> has been removed.");}
} # End Remove Directory Procedure.


# Begin Rename Procedure:
sub rename_file
{
if ($FORM{'name'} eq '')
{
print <<EOM;
<P><B>Hold on a second...<P></B>
You had selected the <B><TT>Rename</TT></B> option, but you didn't select a 
file or directory to rename. That is a required part of using the rename 
function. Please click on one of the radio buttons:<BLOCKQUOTE> 
<FORM><INPUT TYPE=RADIO NAME="trivial" CHECKED></FORM></BLOCKQUOTE>in the 
list below, and try again. If you are using a text-only browser which doesn't 
let you select them, use the down arrow until you are over the radio button 
and then hit the space bar to select.<BR>
EOM
} # End printing error message.
else
{
$name = $FORM{'name'};
&checkname;
$name = $FORM{'newname'};
&checkname;
$oldfile = "$data_path$FORM{'name'}";
$newfile = "$data_path$FORM{'newname'}";
open(NEWNAME,"|$rename $oldfile $newfile");
print NEWNAME $oldfile;
close(NEWNAME);
if ($execute eq 'yes')
	{chmod(0755,"$newfile");}
else
	{chmod(0744,"$newfile");}
&check_creation($newfile);
&report("<B><TT>$oldfile</TT></B> has been renamed <B><TT>$newfile</TT></B>.");
} # Filename given, operation completed.
} # End Rename Procedure.


# Begin Check Writable Procedure
# Accepts an absolute filename to see whether it exists. If not, it 
# returns an error message suggesting that the user make his directory 
# writable.
sub check_creation
{
local($_) = shift;
if (!(-e $_))
	{
print <<EOM;
<BLOCKQUOTE>
<FONT FACE="arial" SIZE=4>
...And our attempt to create, rename or upload a file or directory 
has failed.<P>
Why? And what can be done about it?<P>
Friend, these are deep issues. Perhaps this file was never meant to 
exist on this server, and the Powers That Be have sent it to 
/dev/null. Many a worthy file has found its end there.<P>
However, the most probable reason is that this script does not have 
permission from the server to create new files or directories in the 
intended location.<P>
As to what can be done, well... if you are comfortable using 
Telnet, you should telnet to this site and type the following:
<BLOCKQUOTE><PRE>chmod 777 $data_path
chmod 777 $data_path*.*</PRE></BLOCKQUOTE>
Alternately, if you use CuteFTP or WS_FTP, make this directory 
writable from your FTP client.<P>
Understand that sometimes, things just fail. People fail. Governemnts 
fail. And yes, CGI scripts fail. You could always read the 
documentation, or you could write to us to report a possible 
bug.</FONT>
</BLOCKQUOTE><BR><BR><BR>
EOM
&end_html;
exit;
	}
}


# Begin Delete Only Error Procedure
sub delete_only_error
{
print <<EOM;
<BLOCKQUOTE>
<FONT FACE="arial" SIZE=4>
This action was aborted, because your disk space allotment is 
full or near full (less than thirty kilobytes).<P>
Please delete some files or directories before proceeding. Alternately, 
you may ask the webmaster to allocate more disk space to this 
account.</FONT></BLOCKQUOTE><BR><BR><BR>
EOM
}

# __________________________________________________________________
#
# Setting Preferences on the Fly Procedures:
#	The GENESIS user may wish to change some of his non-security-
#	related options while using the script.  Since the whole purpose 
#	of this script is to avoid Telnet/FTP, we want to make it easy 
#	to set preferences.  Specifically, the user can set:
#		default height & width for TEXTAREA
#		default $pretext template
#		sort order for &list_files
#		$link_url & $link_title
# __________________________________________________________________


# Begin Load Preferences Procedure:
sub load_prefs
{
open(FILE,"$prefs_file");
@LINES = <FILE>;
close(FILE);
foreach $LINE (@LINES)
	{
	@terms = split(/=/,$LINE);
	if ($terms[0] eq 'pretext')
		{
		$TEMPLATES{$terms[1]} = $terms[2];
		$selected = $terms[1] if ($terms[3] eq 'selected');
		}
	else
		{$PREFS{$terms[0]} = $terms[1];}
	}
$rows = $PREFS{'rows'};
$cols = $PREFS{'cols'};
$sort_order = $PREFS{'sort_order'};
$show_tips = $PREFS{'show_tips'};
$link_url = $PREFS{'link_url'};
$link_title = $PREFS{'link_title'};
} # End Load Preferences Procedure.


# Begin Show Preferences Procedure:
sub show_prefs
{
print <<EOM;
<FORM METHOD=POST ACTION="$cgi">
<INPUT TYPE=HIDDEN NAME="action" VALUE="save_prefs">
<B>Your current GENESIS settings:</B><P>
<BLOCKQUOTE>
<PRE>  URL for upper hyperlink: <INPUT TYPE=TEXT NAME="link_url" VALUE="$link_url" SIZE=40>
Title for upper hyperlink: <INPUT TYPE=TEXT NAME="link_title" VALUE="$link_title" SIZE=40></PRE>

When listing all files, sort by: <SELECT NAME="sort_order">
EOM
foreach $sort_method (Name,Size,Type)
	{
	print "<OPTION";
	print " SELECTED" if ($sort_order eq $sort_method);
	print ">$sort_method\n";
	}
print <<EOM;
</SELECT><P>
<INPUT TYPE=CHECKBOX 
EOM
print "CHECKED " if ($show_tips eq 'yes');
print <<EOM;
NAME="show_tips"> Show tips
</BLOCKQUOTE>

<B>Text Editing Options:</B>
<BLOCKQUOTE>
<PRE>Height of Text Box: <INPUT TYPE=TEXT NAME="rows" VALUE="$rows" SIZE=3>
 Width of Text Box: <INPUT TYPE=TEXT NAME="cols" VALUE="$cols" SIZE=3></PRE>
<P>
<TABLE BORDER=0>
<TR><TD><B><FONT SIZE=-1>Default</FONT></B></TD>
<TD ALIGN=CENTER><B>Template Name</B></TD><TD ALIGN=CENTER><B>Full Path to File</B></TD></TR>
<TR><TD><BR></TD>
<TD><INPUT TYPE=TEXT VALUE="- No Template" SIZE=15></TD>
<TD><INPUT TYPE=TEXT VALUE="/dev/null" SIZE=60></TR></TR>
EOM
$iterator = 1;
foreach $key (sort keys %TEMPLATES)
	{
	print "<TR><TD><INPUT TYPE=RADIO NAME=\"default_template\"";
	print " CHECKED" if ($key eq $selected);
	print " VALUE=\"$key\"></TD>\n";
	print "<TD><INPUT TYPE=TEXT NAME=\"name-$iterator\" VALUE=\"$key\" SIZE=15></TD>\n";
	print "<TD><INPUT TYPE=TEXT NAME=\"file-$iterator\" VALUE=\"$TEMPLATES{$key}\" SIZE=60></TD>\n";
	print "</TR>\n";
	$iterator++;
	}
print <<EOM;
<TR><TD><INPUT TYPE=RADIO NAME="default_template"></TD>
<TD><INPUT TYPE=TEXT NAME="name-$iterator" VALUE="New" SIZE=15></TD>
<TD><INPUT TYPE=TEXT NAME="file-$iterator" SIZE=60></TD></TR>
</TABLE>
Select the template you would like to default to using the left radio button 
(of course you can still use the others). If you would like to create a new 
template, enter the name and location in the lower set of fields.<P>

<CENTER><INPUT TYPE=SUBMIT VALUE="Save New Preferences"></CENTER></FORM>
</BLOCKQUOTE><BR><BR><BR>
EOM
} # End Show Preferences Procedure.


# Begin Save Preferences Procedure:
sub save_prefs
{
open(FILE,">$prefs_file");
print FILE "link_url=$FORM{'link_url'}=\n";
print FILE "link_title=$FORM{'link_title'}=\n";
print FILE "sort_order=$FORM{'sort_order'}=\n";
if ($FORM{'show_tips'} eq 'on')
	{print FILE "show_tips=yes=\n";}
else
	{print FILE "show_tips=no=\n";}
print FILE "rows=$FORM{'rows'}=\n";
print FILE "cols=$FORM{'cols'}=\n";
@numbers = "";
foreach $key (sort keys %FORM)
	{
	@terms = split(/-/,$key);
	if ($terms[1])
		{@numbers = (@numbers,"$terms[1]");}
	}
foreach $number (@numbers)
	{
	$var1 = "name-$number";
	$var2 = "file-$number";
	if (($number ne "") && ($FORM{$var1} ne "") && ($FORM{$var2} ne ""))
		{
		print FILE "pretext=";
		print FILE "$FORM{$var1}=";
		print FILE "$FORM{$var2}=";
		print FILE "selected=" if ($FORM{$var1} eq $FORM{'default_template'});
		print FILE "\n";
		}
	}
close(FILE);
&report("Your <B><TT>GENESIS</TT></B> preferences have been saved; <B><TT>reload</TT></B> for them to take effect.");
} # End Save Preferences Procedure.


# Begin Buffer Number Procedure:
sub buffnum
{
$net_digits = 12;
local($_) = shift;
$num_size = split(//,$_);
for ($i=$num_size;$i<=$net_digits;$i++)
	{$_ = " $_";}
return $_;
} # End Buffer Number Procedure.


# Begin Report Procedure:
# Takes a text string and prints to screen.  If logging is enabled, writes to 
# log file.
sub report
{
local($_) = shift;
print "$_<BR>\n";
if ($logfile)
	{
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
@months = ("January","February","March","April","May","June","July","August","September","October","November","December");
@digits = split(//,$sec);
$size = @digits;
if ($size == 1)
	{$sec = "0$sec";}
@digits = split(//,$min);
$size = @digits;
if ($size == 1)
	{$min = "0$min";}
$date = "@months[$mon] $mday, 19$year $hour:$min:$sec Eastern Time";
	open(LOG,">>$logfile");
	print LOG "$ENV{'REMOTE_ADDR'}: $date: ";
	print LOG "$_\n";
	close(LOG);
	} # End Write to Log.
} # End Report Procedure.