#!/usr/bin/perl

############################################################################
### Copyright (C)  Tripodics.com
### Author:	Bruce A. Martin
### File Name:	mkdir.pl
### Purpose:	Make a subdir
### Versions:
my $ver="8.1";
###	8.1	bam:2009/130	Debug
###	8.0	bam:2008/521	Revise (dirs, cgi-bin, etc.) and fix security
#			FORM METHOD=POST 
###	7	bam:2006/b15		(was mkdir.pl)
###	0.1e	bam:2005/211		mkdir.pl -- Create subdir (mkdir) (WUSB)
###	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>";


#### 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};
#
my $dirname=	$in_para{SUBSUB};
#

## Allowable characters only.
$dirname =~ s|[^-A-Za-z0-9_/.]|_|g;	
#
## Security considerations.
$dirname =~ s|[.][.][.]*||g;			# Disallow multiple dots.
$dirname =~ s|^\.||g;				# Disallow leading dot.
$dirname =~ s|^/||g;				# Disallow leading slash.
$dirname =~ s|/\.||g;				# Disallow slash dot.
$dirname =~ s|//*|/|g;				# Disallow multiple slashes.
$dirname =~ s|~||g;				# Disallow tilde (~username).


######## PATHS & FILENAMES ########
my $pwd=	`pwd`;
my $ppwd=	`cd ..; pwd`;				# Parent directory.
#my $sub=	`cd ..; basename \`pwd\` `;  
#chop $sub;

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


#### 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;"; 



#### Main processing.  #### 
#
	print "<HEAD><TITLE> WUSB.FM/$prepath/$dirname --  Create subdir. </TITLE>\n";
	print "<BODY BGCOLOR=#99FF33>\n";

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

	if ( -e "$prepath/$dirname") {
		print "<H2>$prepath/$dirname EXISTS already.</H2><UL>\n";
		if ( -d "$prepath/$dirname") { print "<LI>$dirname is directory.\n";  }
		#if ( -d "$prepath/$dirname") { ;  }
		elsif ( -l "$prepath/$dirname") { print "<LI>$dirname is a symbolic-link.\n"; }
		elsif ( -f "$prepath/$dirname") { print "<LI>$dirname is a file.\n"; }
		elsif ( -T "$prepath/$dirname") { print "<LI>$dirname is a text file.\n"; }
		elsif ( ! -w "$prepath/$dirname") { print "<LI>$dirname cannot be written.\n"; }
		print "</UL>\n";
	} else {

		print "<H1> Create subdir:  $NBSP $prepath/$dirname </H1>";

		#### Create dir.
		mkdir "$prepath/$dirname" ;
		print "OK<BR><BR>";
	}


	#### Close this window.
	print "<FORM ACTION=$Q$Q METHOD=POST>\n";
	print "$SP4 <INPUT NAME=QUIT 
		TYPE=SUBMIT VALUE=${Q}Close this window$Q 
		onClick=${Q}window.close()$Q>\n";
	print "</FORM>\n";

	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.)          +++#
############################################################################


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

