Advertisement

06.18.2008 at 05:23PM PDT, ID: 23497365
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.4

Perl script keeps showing Error 500

Asked by mcnuttlaw in Perl Programming Language

Tags:

I have perl code to dynamically list the folder contents of a specific directory on to a website.  A user simply maintains the folder/file structure within Windows Explorer and the script will list the folder contents for listing on a website.

All was working just fine until we switched to a Linux web host.  I believe the original web hosting plan was a unix-based server.  Now the script simply shows a Server 500 error.

Uploaded in ascii - yes
edited script using Wordpad - yes
Path to Perl confirmed - yes
chmod 755 on cgi-bin - yes
chmod 755 on cgi-bin sub directory - yes
chmod 755 on script itself - yes

The script pulls from a header/footer text files which contains simple html.
The script is called by http://www.domain.com/cgi-bin/list.cgi?case

Ideas anyone?Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:

#!usr/bin/perl
#
 
########################################################
# URL of this script
$script    = "http://www.domain.com/cgi-bin/content/list.cgi";
 
########################################################
# URL to images directory, relative or absolute
$imagedir  = "http://www.domain.com/images/listfiles";
 
########################################################
# Header and Footer files
$header = "header.txt";
$footer = "footer.txt";
 
########################################################
# File types with their own images, the images should be named [type].gif
@filetypes = ("avi", "bmp", "gif", "html", "jpg", "mov", "mpeg", "swf", "txt", "zip", "pdf", "doc", "xls", "shtml", "rtf");
 
########################################################
# To enable internal text viewer, set to 1, or 0 otherwise
$textviewer= 0;
 
########################################################
# File types which uses the internal text viewer
@texttypes = ("txt");
 
#use CGI;
#$query=new CGI;
#Read all the HTML variables into local perl variables.
#$act   = $query->param('act');
#$link  = $query->param('link');
#$ctype = $query->param('ctype');
 
#if ($act eq "1") {
#	&sendfile;
#    } else {	
#	$action = "browse";
#    }
 
#$action = "browse";
$messageflag = "0";
$filemessageflag = "0";
 
($ctype, $action, $vir_path) = split(/&/, $ENV{'QUERY_STRING'});
 
if ($ctype eq "case")
{
# Base absolute path and base URL, $basedir SHOULD point to $baseurl
$basedir   = "/imedia/users/username/htdocs/cases/content";
$baseurl   = "http://www.domain.com/cases/content";
$title_alt = "Back to Main Cases";
$title     = "Main Cases";
$bgcolortitle = "#336699";
$bgcolordir   = "#99ccff";
 
# Header and Footer files
$header    = "header_cases.txt";
$footer    = "footer.txt";
$action    = "browse";
$foldergif = "dir_yellow.gif";
$foldergifsub = "dir_blue.gif";
}
else
{
if ($ctype eq "article")
{
# Base absolute path and base URL, $basedir SHOULD point to $baseurl
$basedir   = "/imedia/users/username/htdocs/articles/content";
$baseurl   = "http://www.domain.com/articles/content";
$title_alt = "Back to Main Articles";
$title     = "Main Articles";
$bgcolortitle = "#333333";
$bgcolordir   = "#e1ddd5";
 
# Header and Footer files
$header    = "header_articles.txt";
$footer    = "footer.txt";
$action    = "browse";
$foldergif = "dir_purple.gif";
$foldergifsub = "dir_blue.gif";
}
else
{
print "Location: http://www.domain.com \n\n";
print "Content-Type: text/html\n\n";
print &header;
print "<center><font size=3 face=arial,times new roman,verdana color=red>\n";
print "<b>ACCESS DENIED</b></font><br><br>\n";
print &footer;
exit;
}
}
 
# END OF CONFIG
########################################################
 
 
($garbage1, $action, $vir_path) = split(/&/, $ENV{'QUERY_STRING'});
$vir_path =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if ($ENV{'QUERY_STRING'} ne "") {
	if ($vir_path =~ /^\.\./ || $vir_path =~ /\/\.\.\// || $vir_path =~ /\.\.$/) {
		print "Content-Type: text/html\n\n";
		#print &header;
		print "<font size=3 face=arial,times new roman,verdana><b>You are not allowed to access a higher level directory with ..</b></font>\n";
		#print &footer;
		exit;
		}
	else {
		$path = "$basedir/$vir_path";
		$action = "browse";
		}
	}
else {
	$path   = $basedir; 
	$action = "browse";
	}
 
#$alt = $ENV{'QUERY_STRING'} =~ /[?&]browse=([^&]*)/;
$thisdir = ($vir_path eq "") ? "" : "$vir_path/";
#$currentdir = ($vir_path eq "") ? "" : "/$vir_path";
$currentdir = $vir_path;
($action eq "browse") ? &browse : &get;
 
######################################
sub browse {
opendir(BASE, $path);
@names = readdir(BASE);
closedir(BASE);
foreach $name (@names) {	
	$isdir = opendir(DIR, "$basedir/$thisdir$name");
	if ($isdir == 1) {
		push(@dirs, $name) unless ($name eq '.' || $name eq '..');
		}
	else {
		push(@files, $name);
		}
	closedir(DIR);
	
	(undef, undef, undef, undef, undef, undef, undef,
	$size, undef, $modified, undef, undef, undef) = stat("$basedir/$thisdir$name");
	($min, $hr, $day, $mon, $yr) = (localtime($modified))[1,2,3,4,5];
	$min = "$min" unless $min >= 10;
	$hr  = "$hr"  unless $hr  >= 10;
	$day = "$day" unless $day >= 10;
	$mon = $mon + 1 unless $mon >= 10;
	if ($yr =~ 100){$yr = 2000}
	elsif ($yr =~ 100){$yr = 2001}
	elsif ($yr =~ 102){$yr = 2002}
	elsif ($yr =~ 103){$yr = 2003}
	elsif ($yr =~ 104){$yr = 2004}
	elsif ($yr =~ 104){$yr = 2005}
	elsif ($yr =~ 104){$yr = 2006}
	elsif ($yr =~ 104){$yr = 2007}
	elsif ($yr =~ 104){$yr = 2008}
	elsif ($yr =~ 104){$yr = 2009}
	elsif ($yr =~ 104){$yr = 2010}
	elsif ($yr =~ 104){$yr = 2011}
	$filesize{$name} = $size;
	$last_mod{$name} = "$mon/$day/$yr";
	}
 
 
print "Content-Type: text/html\n\n";
print &header;
$thisdir =~ s/ /\%20/g;
print "<table border=0 cellpadding=2 cellspacing=1 width=75% align=center>\n";
print "<tr bgcolor=\"$bgcolortitle\">\n";
print "<td align=left width=90%><font class=\"smalltitle\" nowrap>&nbsp;Case Folder&nbsp;/&nbsp;File Name</font></td>\n";
#print "<td align=center width=20%><font class=\"smalltitle\" nowrap>Uploaded</font></td>\n";
print "<td align=right width=10%><font class=\"smalltitle\" nowrap>Size *</font></font></td>\n";
print "</tr>\n";
 
if ($vir_path ne "") {
	$temp = $vir_path =~ tr#/#/#;
	if ($temp > 0) {
		$pardir = "?$ctype&browse&".substr($vir_path, 0, rindex($vir_path, "/"));
		$desc1 = "<b>>&nbsp;<a href=\"list.cgi\?$ctype&browse\" title=\"$title_alt\">$title</a>&nbsp;>&nbsp;</b>";
		$desc2 = substr($vir_path, 0, rindex($vir_path, "/"));
		$dir_pardir = $pardir;
		$dir_pardir =~ s/ /\%20/g;
		}
	else {
		$pardir = "";
		$desc1 = "<b>>&nbsp;<a href=\"list.cgi\?$ctype&browse\" title=\"$title_alt\">$title</a></b>";
		}
 
	print "<tr>\n<td colspan=\"3\" bgcolor=\"$bgcolordir\" align=\"left\">\n";
	print "<font class=\"small\">\n";
	print "<img src=\"$imagedir/up.gif\" align=\"absbottom\">&nbsp;&nbsp;$desc1<b><a href=\"$script$dir_pardir\" title=\"Back to $desc2\">$desc2</a></b>\n";
	}
print "</font>\n";
print "</td>\n</tr>\n";
 
 
 
foreach $dir (sort @dirs) {
	$dir_url = $dir;
	$dir_url =~ s/ /\%20/g;
	print "<tr>\n<td bgcolor=#f0f0f0 align=left nowrap>\n";
	print "<font class=\"small\"><b>\n";
 
	if ($currentdir ne "")
	{
	$homedir = "";
	$privatetest = substr($currentdir, 0, 7);
	if (substr($currentdir, 0, 7) =~ "private")
		{$gif = "dir_lock.gif";
		print "<img src=\"$imagedir/$gif\" align=\"absbottom\">&nbsp;&nbsp;<a href=\"../../cases/content/$thisdir$dir_url\/index.asp?dir=$dir_url\">$dir</a></b></font> \n";
		}
	else
		{$gif = $foldergifsub;
		print "<img src=\"$imagedir/$gif\" align=\"absbottom\">&nbsp;&nbsp;<a href=\"$script?$ctype&browse&$thisdir$dir_url\">$dir</a></b></font> \n";
		}
 
 
	}
 
else
 
	{
	$homedir = "Main Directory";
	if ($dir =~ "private")
		{$gif = "dir_lock.gif";}
	else
		{$gif = $foldergif;}
	
	
	print "<img src=\"$imagedir/$gif\" align=\"absbottom\">&nbsp;&nbsp;<a href=\"$script?$ctype&browse&$thisdir$dir_url\">$dir</a></b></font> \n";
	}
 
	print "</td>\n";
	#print "<td align=center bgcolor=#f0f0f0 nowrap><font class=\"small\">&nbsp;&nbsp;</font></td>\n";
	print "<td align=right bgcolor=#f0f0f0 nowrap><font class=\"small\">&nbsp;&nbsp;</font></td>\n";
	print "</tr>\n";
	}
 
foreach $file (sort @files) {
	$ext = substr($file, rindex($file, "\.")+1);
	$type = "file";
	foreach $filetype (@filetypes) {
		if (lc($ext) eq $filetype) {$type = $filetype;}
		}
	$file_url = $file;
	$file_url =~ s/ /\%20/g;
	$file_und = $file;
	$file_txt = $file;
	$file_und =~ s/_/\ /g;
	$file_txt =~ s/.$type/\.txt/g;
 
if ($file ne "message.txt")
{
if ($file ne "index.asp")
	{
	if ($type ne "txt")
	{
	$filemessageflag = "1";
	print "<tr>\n<td valign=top bgcolor=#f0f0f0 align=left nowrap>\n";
 
	# Original
	#print "<img src=\"$imagedir/$type.gif\" alt=\"$type\" align=\"absbottom\">&nbsp;&nbsp;<a href=\"$baseurl/$thisdir$file_url\" target=\"blank\">$file_und</a></font>\n";
 
	# Counter script
	print "<img src=\"$imagedir/$type.gif\" alt=\"$type\" align=\"absbottom\">&nbsp;&nbsp;<font class=\"small\"><a href=\"../redirect/jump.asp?r=$thisdir$file_url&type=$ctype\" target=\"_blank\">$file_und</a></font>\n";
 
	if ($filemessageflag =~ "1")
		{
		print &filemessage;
		$filemessageflag = "0";
		}
 
	print "</td>\n";
	#print "<td align=center valign=top bgcolor=#f0f0f0 nowrap><font class=\"small\">$last_mod{$file}</font></td>\n";
	print "<td align=right valign=top bgcolor=#f0f0f0 nowrap><font class=\"small\">";
	#print commify($filesize{$file});
	#print "&nbsp;";
	print &filetag;
	#print $type;
	print "</font>\n";
	print "</td></tr>\n";
	}
 
	}
}
else
	{
	$messageflag = "1";
	print "\n";
	}
 
	}
 
if ($messageflag ne "0")
	{
        print "<tr>\n<td colspan=3 bgcolor=#f0f0f0 align=left>\n";
        print "<br><font class=\"small\">\n";
        print "<b>Notes regarding this directory:</b><br><br>";
        print &message;
        print "</font><br>&nbsp;\n";
        print "</td>\n</tr>\n";
	}
 
        print "<tr>\n<td colspan=3 bgcolor=#e0e0e0 align=left>\n";
        print "<font class=\"smallfooter\">\n";
        print "&nbsp;<b>Current Directory:</b>&nbsp;&nbsp;";
	print $homedir;
	print $currentdir;
        print "</font>\n";
        print "</td>\n</tr>\n";
 
print "</table>\n";
print &footer;
}
 
################################################
sub get {
if ($textviewer) {
	$ext = substr($vir_path, rindex($vir_path, "\.")+1);
	foreach $type (@texttypes) {
		if ($type eq $ext) {
			$flag = 1;
			}
		}
	if ($flag) {
		print "Content-Type: text/html\n\n";
		print &header;
		open(FILE, "$basedir/$vir_path");
		print "<font face=arial,times new roman,verdana size=2><b>Using Internal Document Viewer:</b></font><p><font face=Courier size=2>\n";
		$line = join("<br>", <FILE>);
		$line =~ s/ /&nbsp;/g;
		print $line;
		print "</font>\n";
		close(FILE);
		print &footer;
		exit;
		}
	}
 
#print "Location: $baseurl/$vir_path\n\n";
print "Content-Type: text/html\n\n";
print "<center><font size=3 face=arial,times new roman,verdana color=red>\n";
print "<b>Error</b></font><br><br>\n";
exit;
}
 
##############################
# Return the Header contents
sub header {
open(HEAD, $header) or die("Cannot open $header");
@lines = <HEAD>;
close(HEAD);
return @lines;
}
 
##############################
# Return the Footer contents
sub footer {
open(FOOT, $footer) or die("Cannot open $footer");
@lines = <FOOT>;
close(FOOT);
return @lines;
}
 
##############################
# Return the Message contents
sub message {
#open(FILE, "$baseurl/$thisdir$file_url") or die("Cannot open message.txt");
open(FILE, "$basedir/$vir_path/message.txt");
$line = join("<br>", <FILE>);
#$line =~ s/ /&nbsp;/g;
print $line;
close(FILE);
return;
}
 
###################################
# Return the file message contents
sub filemessage {
#open(FILE, "$baseurl/$thisdir$file_url") or die("Cannot open $file");
open(FILE, "$basedir/$vir_path/$file_txt");
$line = join("<br>", <FILE>);
#$line =~ s/ /&nbsp;/g;
 
if ($line ne "")
	{
	print "<!-- Begin message table -->\n";
	print "<br>\n";
        print "<table width=\"90%\">\n";
	print "<tr><td>&nbsp;\&nbsp;</td>\n";
	print "<td bgcolor=#f0f0f0 align=left>\n";
	print "<font class=\"smallfooter\"><i>\n";
	#print $file_txt;
	print $line;
	print "</i></font>\n";
	print "</td></tr>\n";
	print "</table>\n";
	print "<!-- End message table -->\n";
	}
 
close(FILE);
return;
}
 
##############################
# Put commas in the file size
sub commify {
    my $text = reverse $_[0];
    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
    return scalar reverse $text;
}
 
##############################
# Determine file size
sub filetag {
$temp = $filesize{$file};
 
if ($temp >= 1000000) {
        $text ="mb";
	$temp = $temp / 1000000;
	printf("%.2f", $temp);
    } elsif ($temp >= 1000) {
        $text = "kb";
	$temp = int($temp / 1000);
	print $temp;
    } else {
        $text = "bytes";
	print $temp;
    }
 
print "&nbsp;";
print $text;
return;
}
 
##############################
# Log the entry as a download click
# and then send the file to the user
sub sendfile {
#$basepath = './';
#require("$basepath/log.cgi");
#require("../download/log.cgi");
}
[+][-]06.18.2008 at 07:13PM PDT, ID: 21818776

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]06.18.2008 at 07:16PM PDT, ID: 21818785

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]06.18.2008 at 08:34PM PDT, ID: 21819020

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zone: Perl Programming Language
Tags: Perl
Sign Up Now!
Solution Provided By: Tintin
Participating Experts: 3
Solution Grade: A
 
 
[+][-]06.18.2008 at 08:36PM PDT, ID: 21819028

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
 
Loading Advertisement...
20081112-EE-VQP-42 / EE_QW_2_20070628