#!/usr/bin/perl

############################################################################
### Copyright (C)  Tripodics.com
### Author:	Bruce A. Martin
### File Name:	upmodify.pl
### Purpose:	Modify a text file
### Versions:
my $ver="10.1";
###	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.1	bam:2007/1007		Add buttons at top.
###	7	bam:2006/1115		(was modify.pl)
###	0.2d	bam:2004/10/17		modify.pl -- Work on parent dir	(for WUSB staffer subdirs)
###	0.2c	bam:2004/908		edit.pl
###	0.1b	bam:2004		(Ideas.)
###	0.1	bam:2004(428)04W	Store content, fetch into textarea.
#############################################################################

use strict;
use CGI qw/:standard/;

$| = 1;
print header;		# html format is permitted to output. 
print "<HTML>";

my $stamp=  $^T;				# Timestamp.
my $color="";

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

my $content=$in_para{CONTENT};
my $h=$in_para{H};



#### Get the FORM inputs.
#
my $BUG = $in_para{BUG};			# Debugging print.
if ($BUG =~ /^\s*BUG\s*$/) { $BUG = '0'; }
#
### Get form inputs.
my $COURSE = $in_para{COURSE};
my $SECTION = $in_para{SECTION};
my $WHO = $in_para{WHO};
my $FOLDER = $in_para{FOLDER};

my $filename=	$in_para{FILENAME};

#??	if ($filename =~ /^[^A-Za-z0-9]*$/)	{$filename = "test.dat";}


#NEW:  Script is now in "cgi-bin/up/".
#	Acd to 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 "$blackhole";
chdir( $blackhole ) or die;


### Allowable characters only.
my $stud=	"students";
my $course=	$COURSE;	&sterilize( $course );
my $section=	$SECTION;	&sterilize( $section);
my $who=	$WHO;		&sterilize( $who );
my $folder=	$FOLDER;	&sterilize( $folder );
my $base=	"\$/.update";
#	&say("<li>course=$course, section=$section, who=$who, folder=$folder");
#
my $prepath=	"$course/$section/$stud";	&sterilize( $prepath );
my $path=		"$who/$folder";			&sterilize( $prepath );
#
my $abspath=	"/$course/$section/$stud/$who/$folder";	# (Begins with "/")
my $relpath=	"../../$folder";			# (Inculdes ..)
my $basepath=	"$home/GOTO/$prepath/$who/$base";



### Execute from base.
&docmd( "pwd" );
&say( $basepath );
say( "<HR>" );
chdir( $basepath ) ;#or die;

&docmd( "pwd" );
say( "<HR>" );

#??? check for OK file, before executing
#
#++++++ Append to log file!  (Fail, if none here.)
my $ok=  "# upmodify.pl $stamp ";
`echo "$ok  " >> `;



## Allowable characters only.
$filename =~ s|[^-A-Za-z0-9_/.]|_|g;		
#

#--	## Other security considerations.
#--	#
#--	$filename =~ s|[.][.][.]*||g;			# Disallow multiple dots.
#--	$filename =~ s|^\.||g;				# Disallow leading dot.
#--	$filename =~ s|^/||g;				# Disallow leading slash.
#--	$filename =~ s|/\.||g;				# Disallow slash dot.
#--	$filename =~ s|//*|/|g;				# Disallow multiple slashes.
#--	$filename =~ s|~||g;				# Disallow tilde (~username).
#--	$filename =~ s|;||g;				# Disallow semicolon.

&sterilize( $filename );

if ( -e $filename) {
	#if ( ! -d $filename) { print "$filename is directory.\n";  }
	if ( ! -d $filename) { ;  }
	elsif ( ! -T $filename) { print "$filename is a symbolic-link.\n"; }
	elsif ( ! -T $filename) { print "$filename is not a text file.\n"; die; }
	elsif ( ! -w $filename) { print "$filename cannot be written.\n"; die; }
}


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

#### Set prefix to path. ####
my $name = $ENV { 'COMPUTERNAME' } ;
my $prepath = "../..";

my $textfile;










#### Useful strings.
#
my $Q = '"';
my $LT = '<';
my $GT = '>';
	#$LT="^";	#++++++ FOR DEBUGGING, MAKE TAGS VISIBLE!
my $TAG = $LT;
#
my $TAB=	"	";
my $NBSP=	"&nbsp;";
my $SP4=	"&nbsp;&nbsp;&nbsp;&nbsp;"; 


#### Set up the boilerplate stuff.
#

#### Global variables.
my $text="";



#### Main processing.  #### 
#
	print "<head><title> $filename modify [$ver] </title></head>\n";
	print "<BODY BGCOLOR=#FFCC99>\n";
	print "<H1> Modify a text file:  $NBSP $filename </H1>";

	#if ($filename =~ /^\s*$/) { $filename=""; }
	if ($filename =~ /^\s*$/) { $filename="."; }

	#### Check for file name.
	if ($filename =~ /^\s*$/) {
		print "<FORM ACTION=$Q$Q METHOD=POST>\n";
		print "<H3 ALIGN=CENTER> 
			Please specify file name: 
			<INPUT NAME=FILENAME VALUE=$Q$prepath$filename$Q></H3>";
		print "<P ALIGN=CENTER><INPUT TYPE=SUBMIT VALUE=${Q}SPECIFY FILE NAME$Q>\n";
		print "</FORM>\n"; 
		exit;
	}

	#### Store content into file.  (Then, allow change.)
	if ($content) {
		&storenew( "$prepath/$filename" );
	}
	$content = "";

#++++ Save old with timestamp?  Use rcs/sccs?


	#### Get text from old file (if any).
	if (open(OLDFILE,"<$prepath/$filename")) {
		&getold( "$prepath/$filename" );
	} else {
		print "<P> No old file:  ";
		print "$prepath/$filename";
	}


	#### Display contents of file, and allow modification.
	print "<TABLE BORDER=0><TR><TD>";
	print "<FORM ACTION=$Q$Q METHOD=POST>\n";
	#--	print "<H3 ALIGN=CENTER> <INPUT NAME=FILENAME VALUE=$filename </H3>";
	print "<P ALIGN=RIGHT><INPUT NAME=MODIFY 
		TYPE=SUBMIT VALUE=${Q}MODIFY THE FILE:  $filename $Q>\n";
	print "$SP4 <INPUT NAME=QUIT 
		TYPE=SUBMIT VALUE=${Q}Close this window$Q 
		onClick=${Q}window.close();return false$Q>\n";
	print "<INPUT TYPE=HIDDEN NAME=FILENAME VALUE=$filename>\n";
	print "<H3 XALIGN=CENTER> $filename </H3>\n";
	print "<TEXTAREA NAME=CONTENT ROWS=30 COLS=100>";
		print "$text\n";
	print "</TEXTAREA>\n";
	print "<P ALIGN=CENTER><INPUT NAME=MODIFY 
		TYPE=SUBMIT VALUE=${Q}MODIFY THE FILE:  $filename $Q>\n";
	print "$SP4 <INPUT NAME=QUIT 
		TYPE=SUBMIT VALUE=${Q}Close this window$Q 
		onClick=${Q}window.close();return false$Q>\n";
	print "</FORM>\n";
	print "</TABLE>";

	exit; 



############################################################################
######	Software developed & owned by Tripodics.   ########
####	Copyright 1996-2004 by Tripodics, All Rights Reserved.          ####
####	Tripodics Computing Service, POBox 456 Middle Island, NY 11953  ####
#+++	(Nonexclusive usage granted to WUSB, Stony Brook, NY.)          +++#
############################################################################

sub storenew( $filename )
{
  my $filename = @_[0]; 
  if (open(NEWFILE,">$filename")) {
	print NEWFILE "$content";
	my $status =
	close( NEWFILE );

		#++++ ?rename old with timestamp?
		my $l=  length $content;
		print ": $l bytes written to $filename.  <BR>\n";
  } else {
	print " $filename COULD NOT BE WRITTEN $_ <BR>\n";
  }

}

sub getold( $filename )
{
  my $filename = @_[0];
  open(TEXTFILE,"<$filename") or print " $filename NOT OPENED $_ <BR>\n";
  my $lines;
  while(<TEXTFILE>)
  { 
	$text .= "$_";			# Append line to text.  
	$lines++;
  }#while(<TEXTFILE>)#
  #~	print "$lines lines read from $filename<BR>\n";
  close( TEXTFILE );

}


########  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 WUSB, Stony Brook, NY.)     +++#
############################################################################


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, $$ );
}

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.
	@_[0]=	$s; 
}


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 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; }

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

