#!/usr/bin/perl 
### Maintain files in chosen directory.

########################################################################
### Copyright (C)  Tripodics.com 
### Author:	Bruce A. Martin
### File Name:	update.pl
### (was maint.pl, select.pl)
### Versions:
my $ver="10.2";
###	10.3	bam:2010/409	Protect.  Check for path & password.
###	10.2	bam:2010/405	Eliminate $abspath.  (Use $basepath and $FORMARGS )
###	10.1	bam:2010/404	Use GOTO links only.  DEBUGGING.
###	10.0	bam:2010/330	Revise to work from cgi-bin/up/.  Use GOTO links only.
###	8.0	bam:2008/521	Revise (dirs, cgi-bin, etc.) and fix security
#			FORM METHOD=POST
###	7.3	bam:2007/4/26	Add (secret) switches: BUG & UNHIDE 
###	7	bam:2006/11/15	New scripts, all in cgi/$/.update
###	1.9b	bam:2005/2/11	mkdir
###	1.8a	bam:2004/10/19	Link to upload images (fileup.pl)
###	1.2	bam:2004/02/22	Use tighter Regexp control.  (Rename "abstract.pl")
###	1.1	bam:2004/02/22	Extract descriptions from HTML 
###	0.0	bam:2003/11/20	
#########################################################################

use strict;
use CGI qw/:standard :newtag/;
#??	use "_getargs.txt";
print header;				# html is now permitted to output.
html();


#### Useful strings. ####
my $Q =		'"'; 
my $NL =	"\n"; 
my $TAB=	"	";
my $NBSP=	"&nbsp;";
my $SP4=	"&nbsp;&nbsp;&nbsp;&nbsp;"; 
my $stamp=	$^T; 				# Timestamp.
my $color=	"#000000";

#### Handy temps
my $s;	my $t;


my $args="$0 $1 $2 $3 $4 $5 $6 $7";

### Get parameters from html form.
my %in_para;
foreach (param()){ $in_para{$_} = join " ", param($_); } 
# NOTE:  Multiple-values (checkbox) are joined with blanks.



#### Get the FORM inputs.
#
my $BUG = $in_para{BUG};			# Debugging print.
if ($BUG =~ /^\s*BUG\s*$/) { $BUG = '0'; }
&bug( "<BR>(BUG=$BUG)" );
#
### Get form inputs.
my $COURSE = $in_para{COURSE};
my $SECTION = $in_para{SECTION};
my $STUD = $in_para{STUD};
my $WHO = $in_para{WHO};
my $FOLDER = $in_para{FOLDER};
#--	&say("<li>COURSE=$COURSE, SECTION=$SECTION, STUD=$STUD, WHO=$WHO, FOLDER=$FOLDER");
#
my $MAXLINES = $in_para{MAXLINES};	if ($MAXLINES < 1) { $MAXLINES = 10; }
my $EXT = $in_para{EXT};		if ($EXT =~ /^\s*$/) { $EXT = 'bam'; }
my $UNHIDE = $in_para{UNHIDE};		if ($UNHIDE =~ /^\s*$/) { $UNHIDE = ':'; }




###  On this server, scripts are limited to cgi-bin.
#  PROBLEM:	How to restrict access to allowed dirs (and subtrees)?
#  SOLUTION:	Create a dir ("GOTO") with symbolic links to approved dirs;
#  			chdir to GOTO, then chdir to selected dirs/folders.
#
#  e.g.  Target is ~/www/cst000/00cst000/students/Studentname/sub/
#	                $course $section $list   $who        $sub
#                  
#  Caller (FORM) sends the following parameters:
#  	Caller sends:	$COURSE="cst000" $SECTION="00cst000" $WHO="bam" $FOLDER="what"
#  	These strings must be "sterilized" (removing punctuation) for security reasons.
#  Script will then set up appropriate strings in $prepath and $path
#	Script will then do a chdir to GOTO/$prepath/$path/$base
#	($base is "/$/.update/" for consistency with old scripts.)

### This script modifies files in a specified directory/subdirectory
#		e.g.	~/www/cst000/00cst000/students/Whoever/whatever/
#			      $course $section $list   $who    $sub
### To allow editing, an appropriately-named "log" file must exist in a "base" at:
#		e.g.	~/www/cst000/00cst000/students/bam/$/.update
#			                                  $DOLLAR  $DOT
#   Also, append a line to the "log" file, whenever transactions occur.
### 


### Script should do the following:
#	- First, chdir to BLACKHOLE.  		else die	(silently)
#	- chdir to $path/$base			else die	(with message)
#	- (Check for OK file here?)
#	- run the update.pl script from "base" (using relpath only).
#	- access files via ../$folder
#	- (other scripts must also chdir to run.)


#NEW:  Script is now in "cgi-bin/up/".
#	Use only the symbolic links in GOTO -- then use relative paths only!
#
my $home=	`pwd`;		# Save the Dir of this script:	~/www/cgi-bin/up
$home =~	s|\n||g;	# Remove trailing LF.
$home =~	s|[ 	\n]||g;	
#
my $blackhole="GOTO/BLACKHOLE";
print ".";
chdir( $blackhole ) or &saydie("<BR>NO BLACKHOLE\n");



######## PATHS & FILENAMES ########

### Allowable characters only.
my $course=	&sterilize( $COURSE );
my $section=	&sterilize( $SECTION);
my $stud=	&sterilize( $STUD);	if ($stud =~ "") {$stud= &sterilize("students"); }
my $who=	&sterilize( $WHO );
my $folder=	&sterilize( $FOLDER );	# (May be empty.)
my $base=	"\$/.update";
#--	&say("<li>course=$course, section=$section, stud=$stud, who=$who, folder=$folder");

### Path variables.
my $prepath=	"$course/$section/$stud";	&sterilize( $prepath );
my $path=	"$who/$folder";			&sterilize( $prepath );
my $basepath=	"$home/GOTO/$prepath/$who/$base";
my $relpath=	"../../$folder";			# (Inculdes ..)
my $webpath=	"/$course/$section/$stud/$who/$folder";	# (Begins with "/" for webroot)
print "<BR><A HREF=$Q$webpath$Q > webpath </A>";

### Execute from base.
print "<BR>chdir( $basepath ) or die;";
chdir( $basepath ) or &saydie("<BR>NO BASEPATH\n");

print "<PRE>";
&docmd( "ls -la" );
print "</PRE>";
#??? check for OK file, before executing
#
read OKFILE, $s, 50;
print $s;


### Check for validation file.
open VALIDATION, "validation";
read VALIDATION, $s, 50;
if ($s =~ "^password\$") {print "validation is ok.";}	else {print "!! validation is NOT ok";}

# Append to log file!  (Fail, if none here.)
my $log=  "LOG:  $stamp";
`echo "$log  " >> logfile `;






read LOGFILE, $s, 50;
print "<BR>LOGFILE:  ++++ $s ++++";



my $FORMARGS=  "";			# Create args for call to upmodify.pl, etc.
$FORMARGS .=	"&COURSE=$course";
$FORMARGS .=	"&SECTION=$section";
$FORMARGS .=	"&WHO=$who";
$FORMARGS .=	"&FOLDER=$folder";
print "<P>FORMARGS:  $FORMARGS";


### Use head & tail files from script dir.
my $head=  "head.html";
my $tail=  "tail.html";



### Main processing
# 
	print "<head><title> $who/$folder ($course):  update.pl [$ver] </title></head>\n";
	print "<body bgcolor=#CCFFFF TEXT=#330033>\n";
        &show( $head );

	print "<P ALIGN=RIGHT>";
	print "<A HREF=$Q#NEWFILE$Q> Create new file.</A>\n";
	print " / <A HREF=$Q#IMAGES$Q> Upload image.</A>\n";
	print "</P>\n";

	&showdir( $relpath ) or &saydie("<BR>NO SUCH DIR:  $relpath\n");
	print "</TABLE><HR>";

	&makenew( $path );		#### New files (text or binary).

        &show( $tail );
	print "<HR>";
	#--	print "<P><A HREF=$Q/$Q> home page </A>\n";
	print "<BR><A HREF=$Q#TOP$Q> TOP </A>\n";

exit;


########  The following subroutines are from the Tripodics Library. ########
#### Copyright 1996-2002 by Tripodics, All Rights Reserved.             ####
#### Tripodics Computing Service, POBox 456 Middle Island, NY 11953     ####
#+++   (Nonexclusive usage granted to PhDsigns, Bay Shore, NY.)     +++#
############################################################################

################################# show.pl
sub show( $f )			# Print contents of an HTML file.
{
	my $f = @_[0];
        open(F,"$f") or return 0;
        while(<F>){ print; }
        close(F);
}

sub showdir( $d )
{
  my $d = @_[0];
  #--	my $dd = $prepath . $path . $d; 
  my $dd = $d; 

  opendir(D,$dd) or return 0;
  my @allfiles;
  if ($UNHIDE !~ "UNHIDE") { 
  	@allfiles = grep !/^\./, readdir D;
  } else {
  	@allfiles = readdir D;
  }
  closedir D;
  print "<LI>#@ allfiles= @allfiles <BR>" if ($BUG > 2) ; 

#print "<BR>PWD:  " . `pwd` . " /  $relpath";
#print "<BR>LS:  " . `ls $relpath` ;

  print "<UL>\n";
  #--	print "<FONT SIZE=+2 COLOR=#000066> Files in directory: $NBSP $who/$folder </FONT>\n";
  print "<FONT SIZE=+2 COLOR=#000066> Files in directory: $NBSP $who/$folder </FONT>\n";
  #print "<BR><I>(Click on file name, to modify it.)</I>\n";

  print "<TABLE BGCOLOR=#FFFFCC BORDER=1 CELLPADDING=6 XALIGN=CENTER>\n";
  print "<TH VALIGN=TOP> <B><U>Name </U></B>	<BR><SMALL><I>(Click to view)</I></SMALL>\n";
  print "<TH VALIGN=TOP> <U>Action</U></B>	<BR><SMALL><I>(if any)</I></SMALL>\n";
  print "<TH>REPLACE\n";
  print "<TH><SMALL>REMOVE</SMALL>	<BR><SMALL><I>to /old/ </I></SMALL>\n";
  print "<TH>";
  print "<TH>Size";
  print "<TH>Modified";



  my $f;
  my $next;
  my $name;
  my $sizetot=0;
  foreach $name ( sort @allfiles ) {
	$name =~ s/\.\.//g;			# Remove .. from name.
	$name =~ s/~/+/g;			# Replace tildes.

	if ($UNHIDE !~ "UNHIDE") 
	{ 
	print "-";
	next if ( $name =~ /^\.[^.\/]/ );	## Hide the hidden files.  ("./" and "../" are OK)
	next if ( $name =~ /^\// );		## No leading slash.
	next if ( $name =~ /^~/ );		## No leading tilde.
	next if ( $name =~ /^[-.\$\/]*$/ );		## Not merely $/. etc.

	next if ( $name =~ /^~/ );		## No leading tilde.
	next if ( -f $name && -x $f  );		## Hide executable files!
	next if ( -f $name && -X $f  );		## Hide executable files!
	next if ( $name =~ /\.pl/i );		## Hide the .pl files.
	#++++ Others to hide or skip??
	}

	#--	my $f = $dd . $name;
	#??	$f = $dd . "/" . $name;
	#--	$f = $abspath . "/" . $name;
	$f = $relpath . "/" . $name;
	my $ff=$f;

	my $href=  $webpath . "/" . $name;		# Abs path -- use in HREF only.

	print "<TR>";					### ONE ROW FOR EACH FILE.
	print "<TD>\n	";				### FILE NAME.

#print "<BR> $ff <BR>\n";
#print "<BR> $href <BR>\n";

	## Special cases for html, text, images, dirs, etc.
	if ( $f =~ /\.s*html*$/i 
	or $f =~ /\.shtml.*$/i 
	or $f =~ /\.htm.*$/i 
	) 
	{
		#--	print "<A HREF=$Q$ff$Q TARGET=_blank>";
		print "<A HREF=$Q$href$Q TARGET=_blank>";
		print "<FONT FACE=${Q}sans-serif$Q COLOR=#990000>";
		print "$name";
		print "</FONT>\n";
		print "<TD>";
		if ( $f =~ /^index\./i ) {next;}		## Skip the index file.
		else {
			print "\n	";
			#--	print "<A HREF=${Q}upmodify.pl?FILENAME=$d$name$Q TARGET=_blank>";
			#--	print "<A HREF=${Q}upmodify.pl?FILENAME=$abspath/$name$Q TARGET=_blank>";
			print "<A HREF=${Q}upmodify.pl?FILENAME=$name$Q TARGET=_blank>";
			print "<IMG SRC=/img/author.gif XBORDER=0 ALIGN=MIDDLE></A>\n";
			#--	print "<A HREF=${Q}upmodify.pl?FILENAME=$d$name$Q TARGET=_blank>";
			#--	print "<A HREF=${Q}upmodify.pl?FILENAME=$abspath/$name$Q TARGET=_blank>";
			print "<A HREF=${Q}upmodify.pl?FILENAME=$name$Q TARGET=_blank>";
			print "<FONT FACE=${Q}sans-serif$Q COLOR=#990000 SIZE=-1>";
			print "<I>(modify HTML)</I></FONT>";
			print "</A>\n";
		}
	} 
	elsif ( $f =~ /\.txt$/i 
	or $f =~ /\.inc$/i 
	or $f =~ /\.js$/i 
	or $f =~ /\.cpp$/i 
	or $f =~ /\.css$/i 
	or $f =~ /\.php$/i 
	or $f =~ /\.asm$/i 
	or $f =~ /\.java$/i 
	or $f =~ /\.vb$/i 
	or $f =~ /\.Designer.vb$/i 
	) 
	{
		#--	print "<A HREF=$Q$ff$Q TARGET=_blank>";
		print "<A HREF=$Q$href$Q TARGET=_blank>";
		print "<FONT FACE=${Q}sans-serif$Q COLOR=#660066>";
		print "$name";
		print "</FONT>\n";
		print "<TD>";
		if ( $f =~ /^index\./i ) {next;}		## Skip the index file.
		else {
			print "\n	";
			print "<A HREF=${Q}upmodify.pl?FILENAME=$d$name$Q TARGET=_blank>";
			print "<IMG SRC=/img/author.gif BORDER=0 ALIGN=MIDDLE>";
			print "<A HREF=${Q}upmodify.pl?FILENAME=$d$name$Q TARGET=_blank>";
			print "<FONT FACE=${Q}sans-serif$Q COLOR=#660066>";
			print "<I>(modify text file)</I></FONT>";
			print "</A>\n";
		}
	} 
	## Images ##
	elsif ( $f =~ /\.gif$/i 
	  or $f =~ /\.png$/i 
	  or $f =~ /\.jpe*g$/i )
	{
		#--	print "<A HREF=$Q$ff$Q TARGET=_blank>";
		print "<A HREF=$Q$href$Q TARGET=_blank>";
		print "<FONT FACE=${Q}sans-serif$Q COLOR=#006600>";
		print "$name";
		print "</FONT></A>\n";
		print "<TD>";
		print "<XXXXXXA HREF=$Q$ff$Q TARGET=_blank>";
		print "<IMG SRC=$Q$ff$Q BORDER=0 WIDTH=96 HEIGHT=64 >";
		print "</A>\n";
	## Symbolic link ##
	} elsif ( -l $f ) {
		#--	print "<A HREF=$Q$ff$Q TARGET=_blank>";
		print "<A HREF=$Q$href$Q TARGET=_blank>";
		print "<FONT FACE=${Q}sans-serif$Q COLOR=#00FF00>";
		print "$name/";
		print "</FONT></A>\n";
		print "<TD> (symlink)";
	## Directory ##
	} elsif ( -d $f ) {
		#--	print "<A HREF=$Q$ff$Q TARGET=_blank>";
		print "<A HREF=$Q$href$Q TARGET=_blank>";
		print "<FONT FACE=${Q}sans-serif$Q COLOR=#006600>";
		print "$name/";
		print "</FONT></A>\n";
		print "<TD>";
		print "<A HREF=${Q}update.pl?DIRNAME=$who/$folder/$Q >";
			print "<FONT COLOR=GREEN>";
			print "chdir &nbsp;";
			print "<B>./$name/</B>";
			print "</FONT>";
		print "</A>\n";
		print " &nbsp; &nbsp;";
		print "<A HREF=${Q}update.pl?DIRNAME=$name/$Q >";
			if ( $name =~ /^ima*g/ ) {
			  print "<IMG SRC=/img/folder-photo.gif BORDER=0 ALIGN=MIDDLE>";
			} elsif ( $name =~ /^photo/ ) {
			  print "<IMG SRC=/img/folder-photo.gif BORDER=0 ALIGN=MIDDLE>";
			} elsif ( $name =~ /^sound/ || $name =~ /^audio/ || $name =~ /^wav/ ) {			
			  print "<IMG SRC=/img/folder-sound.gif BORDER=0 ALIGN=MIDDLE>";
			} else {
			  print "<IMG SRC=/img/folder-green.gif BORDER=0 ALIGN=MIDDLE>";
			}
		print "</A>\n";
	} elsif ( $f =~ /\.$EXT$/i ) {
		#--	print "<A HREF=$Q$ff$Q TARGET=_blank>";
		print "<A HREF=$Q$href$Q TARGET=_blank>";
		print "<FONT FACE=${Q}sans-serif$Q COLOR=#660066>";
		print "$name";
		print "</FONT>\n";
		print "<TD>";
			print "<A HREF=${Q}upmodify.pl?FILENAME=$f$Q TARGET=_blank>\n";
			print "_<IMG SRC=/img/author.gif BORDER=0>_</A>\n";
	} else {
		#--	print "<A HREF=$Q$ff$Q TARGET=_blank>";
		print "<A HREF=$Q$href$Q TARGET=_blank>";
		print "<FONT FACE=${Q}sans-serif$Q COLOR=#000000>";
		print "$name";
		print "</FONT>\n";
		print "<TD>";
	}

	print "</TD>"; 

	print "<TD XBGCOLOR=ORANGE>";
	#### REPLACE ####
	print "<FORM ACTION=${Q}upreplace.pl$Q METHOD=POST TARGET=_blank>\n";
	print "<INPUT TYPE=HIDDEN NAME=UPFILE VALUE=${Q}$name$Q >\n";
	#--	print "<INPUT TYPE=SUBMIT VALUE=${Q}UPFILE: $name$Q >\n";
	print "<INPUT TYPE=SUBMIT VALUE=${Q}Replace$Q >\n";
	#print "<SMALL> $name</SMALL>\n";
	print "</FORM>\n";
	print "</TD>"; 



	print "<TD>";
	#### MOVEOLD ####
	print "<FORM ACTION=${Q}upmove.pl$Q METHOD=POST TARGET=_blank>\n";
	print "<INPUT TYPE=HIDDEN NAME=OLDFILE VALUE=${Q}$name$Q >\n";
	print "<INPUT TYPE=SUBMIT VALUE=OLD >\n";
	print "</FORM>\n";
	print "</TD>"; 


	#### Get file info . ####
	(my $dev, my $inc, my $mode, my $nlink, my $uid, my $gid, my $rdev, my $size, my $atime, my $mtime, my $ctime, my $blksize, my $blocks ) =  stat( $f );
	my $size = -s $f;
	$sizetot += $size;
	my $modstamp = &datetime( $mtime );


	my $type=  $mode / 010000 % 0100;
	my $perm=  $mode & 07777;
	print "<TD ALIGN=RIGHT> <FONT FACE=${Q}sans-serif$Q SIZE=-3> "; 
		if ($type == 4) {printf "d"; }
		elsif ($type == 010) {printf " ";}
		else { printf "%o", $type;}
		printf " %o", " $perm"; 
	print "</FONT> \n";
	print "<TD ALIGN=RIGHT> <FONT FACE=${Q}sans-serif$Q SIZE=-1> $size <SMALL>bytes</SMALL></FONT> \n";
	print "<TD ALIGN=RIGHT> <FONT FACE=${Q}sans-serif$Q SIZE=-1> $modstamp </FONT> \n";

	#print "<TD> $dev, $inc, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks \n";
  }
  print "<\UL>\n";


  ## BACK TO SUB ##
  print "<TR><TD>";
	print "<A HREF=$Q$prepath$Q TARGET=_blank>";
#???? Should this be $Q$prepath$Q ???
	print "<FONT FACE=${Q}sans-serif$Q COLOR=#006600>";
	print "$folder/";
	print "</FONT></A>\n";
  print "<TD BGCOLOR=#9999FF>";
  	print "<A HREF=${Q}update.pl?DIRNAME=$Q >\n";
	print "<FONT SIZE=4><B> RESTART </B></FONT></A><BR>";
	print " <I>(at $folder/ )</I>\n";

  #print "<TR><TD><TD><TD><TD><TD><TD>";
  print "<TD><TD><TD><TD ALIGN=RIGHT BGCOLOR=#FFFF00>";
  print "<B>$sizetot</B>";
}

sub makenew( $d )
{
	my $d = @_[0];
	#--	my $dd = "$path/$d";

	#### Form to add a new text file.
	print "<A NAME=NEWFILE></A>\n";
	print "<TABLE BGCOLOR=#FFCC99 BORDER=8><TR><TD> \n";
	print "<TABLE CELLPADDING=10 BORDER=1 CELLPADDING=6 BGCOLOR=#FFCC66><TR> \n";

	#### CREATE TEXT FILE ####
	print "<TD>\n";
	print "<FORM NAME=FC ACTION=${Q}upmodify.pl$Q METHOD=POST TARGET=_blank>\n";
	print "<INPUT NAME=${Q}F$Q VALUE=$Q$Q SIZE=40 ";
	print "\n	onChange=${Q}if(F.value==''){alert('Specify a file name!');F.focus()}$Q>\n";
	print "<P><INPUT TYPE=SUBMIT VALUE=${Q}CREATE A NEW TEXT FILE$Q\n";
	print "	onClick=${Q}FILENAME.value='$d/'+F.value+'.'+EXT.value;this.form.action='upmodify.pl';return true;$Q>\n";
	
	#### CREATE (touch) & REPLACE ###
	print "<BR><BR><BR>";
	print "<INPUT TYPE=HIDDEN NAME=NEW VALUE=${Q}NEW$Q >\n";
	print "<INPUT TYPE=HIDDEN NAME=UPFILE VALUE=$Q$Q >\n";
	#print "<INPUT TYPE=SUBMIT VALUE=${Q}UPLOAD NEW FILE$Q ";
	#print " STYLE=$Q font-size: 16; font-weight: bold; color: firebrick; background-color: orange $Q";
	#print "	XonClick=${Q} UPFILE.value='$d/'+ F.value+'.'+EXT.value; this.form.action='upreplace.pl'; return true;$Q >\n"; 


	#### TYPE ####
	print "<TD><NOBR>\n";
	print "<U>Text:</U>";
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}shtml$Q onClick=${Q}EXT.value='shtml'$Q >.shtml";
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}html$Q onClick=${Q}EXT.value='html'$Q >.html";
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}css$Q onClick=${Q}EXT.value='css'$Q >.css"; 
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}js$Q onClick=${Q}EXT.value='js'$Q >.js"; 
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}php$Q onClick=${Q}EXT.value='php'$Q >.php"; 
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}inc$Q onClick=${Q}EXT.value='inc'$Q >.inc";
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}txt$Q onClick=${Q}EXT.value='txt'$Q SELECTED=SELECTED>.txt";
	print "<BR> <U>Source code:</U> ";
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}cpp$Q onClick=${Q}EXT.value='cpp'$Q SELECTED=SELECTED>.cpp";
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}asm$Q onClick=${Q}EXT.value='asm'$Q >.asm"; 
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}java$Q onClick=${Q}EXT.value='java'$Q >.java"; 
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}vb$Q onClick=${Q}EXT.value='vb'$Q SELECTED=SELECTED>.vb";
	print "<BR><INPUT NAME=E TYPE=RADIO VALUE=${Q}Designer.vb$Q onClick=${Q}EXT.value='Designer.vb'$Q SELECTED=SELECTED><SMALL>Designer.vb</SMALL>";
	#
	print "<INPUT TYPE=HIDDEN NAME=FILENAME VALUE=${Q}filename.txt$Q >\n";
	print "<INPUT TYPE=HIDDEN NAME=EXT VALUE=${Q}txt$Q ></NOBR>\n";
	print "</FORM>\n";

	print "<TD WIDTH=20 BGCOLOR=WHITE>";

	#### UPLOAD IMAGES ####
	print "<A NAME=IMAGES></A>\n";
	print "<TD BGCOLOR=#FF99FF>";
	print "	<P><B><U>UPLOAD a new file</U> to $path/</B><BR><BR>";
	print "	<FORM ACTION=${Q}upfile.pl$Q METHOD=POST >";
	print "	<INPUT TYPE=HIDDEN NAME=DIRNAME VALUE=${Q}$path$Q />";
	print "	<CENTER><INPUT TYPE=SUBMIT STYLE=$Q font-size: 20; font-weight: bOLd; color: firebrick; background-color: yellow $Q";
	print "		VALUE=${Q}UPLOAD$Q /></CENTER></FORM>\n";

	#### MKDIR ####
	print "<TR><TD BGCOLOR=#99CCFF COLSPAN=4>\n";
	print "<FORM ACTION=${Q}upmkdir.pl$Q METHOD=POST TARGET=_blank>\n";
	print "<INPUT TYPE=SUBMIT VALUE=${Q}CREATE A NEW FOLDER$Q\n";
	print "	onClick=${Q}if(S.value==''){alert('Specify a folder name!');S.focus();return false;}
		SUBSUB.value='$d/'+S.value;
		return true;$Q>\n";
	print "<INPUT NAME=${Q}S$Q VALUE=$Q$Q SIZE=40 ";
	print "\n	onChange=${Q}if(S.value==''){alert('Specify a folder name!');S.focus()}$Q>\n";
	#
	print "<INPUT TYPE=HIDDEN NAME=SUBSUB VALUE=${Q}$Q >\n";
	print "</FORM>\n";
	print "</TABLE>";
	print "</TABLE><HR>\n";
}


######################
#

sub timestamp
{
	my ($sec, $min, $hour, $day, $month, $year, $wday, $yday, $dst) = gmtime();
	$stamp=  sprintf( "20%02d%02d%02dT%02d%02d%02d$%6d", 
		$year % 100, $month+1, $day, $hour, $min, $sec, $$ );
}

#????? Shouldn't this be $s ?????
sub datetime( s )
{
	my $s = @_[0];
	my ($sec, $min, $hour, $day, $month, $year, $wday, $yday, $dst) = localtime($s);
	#print "< my ($sec, $min, $hour, $day, $month, $year, $wday, $yday, $dst) = $s;<BR>" ;
	#--	my $result=  sprintf( "20%02d-%02d-%02d %02d:%02d:%02d.$%6d", 
		#--	$year % 100, $month+1, $day, $hour, $min, $sec, $$ );
	$sec %= 60;
	my $result=  sprintf( "20%02d/%02d/%02d %02d:%02d:%02d", 
		$year % 100, $month+1, $day, $hour, $min, $sec );
	return $result;
}

sub bug( $msg ) { my $msg = @_[0]; &say( "$msg" ) if $BUG>0; }
sub say( $msg )
{
	my $msg = @_[0];
	if ($color != 0) { print "<BR><FONT COLOR=$color>$msg</FONT>" ; }
	else { print "<BR>$msg" ; }
}
sub saydie( $msg ) { my $msg = @_[0]; print $msg; print "<H1>DIE!</H1>"; die; }


sub showpwd( )
{
	my $t;
	$t=  `pwd`; 
	printf( "<BR> PWD:  $t <BR>" );
}
sub docmd( $cmd )
{
	my $cmd = @_[0];
	my $t;
	$t=`$cmd`;
	printf("<LI> $cmd:\n  $t");
}
sub doordie( $cmd`)
{
	my $cmd = @_[0];
	my $t;
	$t=`$cmd` or die;
	print "<H1>DIE!</H1>";
	die;
}

sub sterilize( $s )		# Remove punctuation from file name
{
	my $s=	@_[0];				### Restrict file names.
	$s =~	s|[^-A-Za-z0-9_/.#()]|_|g;	# Allow only these (replace others with "_").
	$s =~	s|[ 	\n]|_|g;		# Remove whitespance (and replace with "_").
	$s =~	s|[.][.][.]*||g;		# Disallow multiple dots.
	$s =~	s|/\.||g;			# Disallow slash dot.
	$s =~	s|~||g;				# Disallow tilde (~username).
	$s =~	s|;||g;				# Disallow semicolon.
	$s =~	s|//*|/|g;			# Discard multiple slashes.
	$s =~	s|^\.||g;			# No leading dot.
	$s =~	s|^/||g;			# No leading slash.
	return $s; 
}

##############################  End of bamlib.inc  #############################
