#! /usr/bin/perl -w
use strict;
use vars qw ( $ENCODE_EXCEPT $BASEDIR $HTMLFILE %data $DELIMETER $DEBUG $body $where $sig $SCRIPT @MONTH %FILETYPE $DIR_CLASS1 $DIR_CLASS2 $VIEW_SCRIPT %DONTSHOW $VIEW_TYPE $HTTP_BASE );

$ENCODE_EXCEPT = 'a-zA-Z0-9\%';
$BASEDIR = '/var/www/fallman.org/daniel.fallman.org/resources/';
$HTTP_BASE = '/resources/';
$HTMLFILE = '/var/www/fallman.org/daniel.fallman.org/browsedata/template/.browse.html';
$DELIMETER = ';';
$DEBUG = 1;
$SCRIPT = 'http://daniel.fallman.org/browse.cgi';
$VIEW_SCRIPT = 'http://daniel.fallman.org/view.cgi';
@MONTH = ( 'jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec' );
$VIEW_TYPE = '\.(jpg|jpeg|gif|png|bmp|txt|c|h|cmd)$';
%FILETYPE = (
	'[dir]' => '/browsedata/folder.gif',
	'[parent]' => '/browsedata/parent.gif',
	'[default]' => '/browsedata/unknown.gif',
	
	'jpg' => '/browsedata/pic.gif',
	'gif' => '/browsedata/pic.gif',
	'png' => '/browsedata/pic.gif',
	'bmp' => '/browsedata/pic.gif',

	'psd' => '/browsedata/psd.gif',
	'ai' => '/browsedata/ai.gif',
	'indd' => '/browsedata/indd.gif',

	'mpg' => '/browsedata/movie.gif',
	'avi' => '/browsedata/movie.gif',
	'mov' => '/browsedata/movie.gif',
	'asf' => '/browsedata/movie.gif',
	'mpeg' => '/browsedata/movie.gif',

	'mp3' => '/browsedata/mp3.gif',
	'mp2' => '/browsedata/mp3.gif',
	'wav' => '/browsedata/mp3.gif',

	'doc' => '/browsedata/msword.gif',
	'pdf' => '/browsedata/pdf.gif',
	'zip' => '/browsedata/zip.gif',
	'ppt' => '/browsedata/ppt.gif',
	'txt' => '/browsedata/txt.gif',

	'html' => '/browsedata/html.gif',
	'cpp' => '/browsedata/cpp.gif',
	'h' => '/browsedata/h.gif',
	'ps' => '/browsedata/ps.gif',
);

%DONTSHOW = (
	'browsedata' => 1,
	'browse.cgi' => 1,
	'browse2.cgi' => 1,
	'view.cgi' => 1,
	'counter' => 1,
	'CVS' => 1,
);


#open(STDERR,">>/tmp/browse.debug");
#print STDERR "\n\n\n\n\n**** ".scalar localtime(time)." ****\n";


$DIR_CLASS1 = 'BodyText';
$DIR_CLASS2 = 'BodyText';

$body = $where = $sig = '';

%data = &GetData();

if( !defined($data{'dir'}) ) {
	if( defined($ENV{'SCRIPT_URL'}) ) { # Did we get here by mod_rewrite?
		$data{'dir'} = $ENV{'SCRIPT_URL'};
		if( $data{'dir'} !~ /\/$/ ) { $data{'dir'} = ''; };
	};
};


&Browse($data{'dir'});

print "Content-Type: text/html\n\n";

open(FIL,$HTMLFILE) or &Error("can't open '$HTMLFILE' for reading ($!)");

while( defined($_ = <FIL>) ) {
	s/<\!-- insert body here -->/$body/;
	s/<\!-- insert location here -->/$where/;
	s/<\!-- insert signature here -->/$sig/;

	print;
};
close(FIL);




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

sub HtmlAlign
{
	my ($in,$len) = @_;
	my ($out) = &Quote($in);
	my ($temp,$i);
	my ($orgin) = $in;

	$in =~ s/<([^\>]+)>//g;
	if( length($in) > (abs($len)-2) ) {
		my ($newin) = substr($in,0,abs($len)-3).'..';
		$orgin =~ s/$in/$newin/;
		$out = &Quote($orgin);
		
		$in = $orgin;
		$in =~ s/<([^\>]+)>//g;
	};


	$temp = abs( abs($len) - length($in) );
	if( $len > 0 ) {
		if( $temp >= 1 ) {
			for( $i = 0; $i < $temp; $i++ ) { $out .= ' '; };
		};
	} else {
		my ($outtemp) = $out;
		$out = '';
		if( $temp >= 1 ) {
			for( $i = 0; $i < $temp; $i++ ) { $out .= ' '; };
		};
		$out .= $outtemp;
	};

	return $out;
};


sub Browse
{
	my ($orgdir) = @_;
	my (@dir,$dir,$isdir,$to,$totext,$icon,@stat,@time,$size,$date,$link,$priv,$class,$dont,$skip,$restrict);

	if( !defined($orgdir) ) { $orgdir = ''; };

	$orgdir =~ s/^\/+//;
	$orgdir =~ s/\.\.//g;
	$orgdir =~ s/(\/){2,}/\//g;
	$orgdir =~ s/\/$//;

	$restrict = 0;
	foreach $dont ( keys %DONTSHOW ) {
		if( $orgdir =~ /^$dont/ ) { $restrict = 1; };
	};

	$dir = $BASEDIR.'/'.$orgdir;
	if( $dir eq '/' ) { $dir = ''; }; # HACK!

	if( (-e "$dir/.htaccess") || ($restrict) ) {
		@dir = ( '..' );
	} else {
		if( !opendir(DIR,$dir) ) {
			$body = "can't browse '$dir' ($!)\n";
		};
		my (@file) = ();
		@dir = ();
		foreach( sort readdir(DIR) ) {
			if( -d "$dir/$_" ) {
				$dir[++$#dir] = $_;
			} else {
				$file[++$#file] = $_;
			};
		};
		push @dir,@file;
		closedir(DIR);
	};

	$where = "/$orgdir";
	foreach( @dir ) {
		if( (/^\./) && !(/^\.\.$/) ) { next; };
		if( $orgdir eq '' && $_ eq '..' ) { next; };
		$skip = 0;
		foreach $dont ( keys %DONTSHOW ) {
			if( /^$dont/i ) { $skip = 1; };
		};
		if( $skip ) { next; };

		if( -d "$dir/$_" ) {
			$isdir = 1;
		} else {
			$isdir = 0;
		};

		@stat = stat("$dir/$_");
		@time = localtime($stat[9]);

		$icon = undef;
		if( $isdir ) {
			$to = $orgdir;
			if( $_ eq '..' ) {
				$to =~ s/\/?([^\/]+)$//;
				$totext = "Parent Directory";
				$icon = $FILETYPE{'[parent]'};
			} else {
				$to .= "/$_";
				$totext = "$_/";
				$icon = $FILETYPE{'[dir]'};
			};
			$link = "$SCRIPT?dir=$to";
		} else {
			if( /\.([^\.]+)$/ ) {
				if( !defined($icon = $FILETYPE{lc($1)}) ) { $icon = $FILETYPE{'[default]'}; };
			} else {
				$icon = $FILETYPE{'[default]'};
			};
			$to = "/$_";
			$totext = $_;
			if( /$VIEW_TYPE/i ) {
				$link = "$VIEW_SCRIPT?file=$orgdir/$_";
			} else {
				$link = $HTTP_BASE."$orgdir/$_";
			};
		};

		if( $isdir ) {
			$size = '-';
		} else {
			$size = $stat[7];
		};

		$date = sprintf("%02d-%s-%04d %02d:%02d",$time[3],$MONTH[$time[4]],($time[5]+1900),$time[2],$time[1]);
		
		if( defined($DIR_CLASS1) && defined($DIR_CLASS2) ) {
			if( $class = !$class ) {
				$body .= "<tr class=\"$DIR_CLASS1\">\n";
			} else {
				$body .= "<tr class=\"$DIR_CLASS2\">\n";
			};
		} else {
			if( defined($DIR_CLASS1) ) {
				$body .= "<tr class=\"$DIR_CLASS1\">\n";
			} else {
				$body .= "<tr>\n";
			};
		};

		$body .= <<EOF;
	<td width="16" valign="top">
		<img border="0" src="$icon" alt="[DIR]">&nbsp;
	</td>
	<td width="348" valign="top">
		<a href="$link">$totext</a>
	</td>
	<td width="160" valign="top">
		$date
	</td>
	<td width="76" align="right" valign="top">
		$size
	</td>
</tr>
EOF
	};
	$sig = $ENV{'SERVER_SIGNATURE'};
};

sub Error
{
	my ($string) = @_;
	my ($pack,$script,$line) = caller();

	print <<EOF;

<b>error!</b><br>
<br>
<blockquote>$string</blockquote><br>
at line $line<br>
<br>
EOF

	exit;
};

sub Debug
{
	my ($mode,$extra,$extra2) = @_;
	my ($bg1,$bg2,$bg3,$bgtemp,$cap,$item,$key,$fel,$knark,$lop);
	my ($out) = '';

	if( !$DEBUG ) { return; };

	if( !defined($mode) ) { return; };

	if( $mode eq 'data' ) {
		$bg1 = '#0000FF';
		$bg2 = '#0000DD';
		$bg3 = '#0000CC';
		$cap = '%data';
		$key = \%data;
	};
	
	if( $mode eq 'env' ) {
		$bg1 = '#FF00FF';
		$bg2 = '#DD00DD';
		$bg3 = '#CC00CC';
		$cap = '%ENV';
		$key = \%ENV;
	};

	if( $mode eq 'query' ) {
		$bg1 = '#FFFF00';
		$bg2 = '#DDDD00';
		$bg3 = '#CCCC00';
		$cap = '[query]';
		$key = undef;
	};

	if( $mode eq 'custom' ) {
		$bg1 = '#00FFFF';
		$bg2 = '#00DDDD';
		$bg3 = '#00CCCC';
		$cap = '['.$extra2.']';
		$key = undef;
	};

	if( !defined($bg1) || !defined($bg2) || !defined($cap) ) { return -1; };

	if( !defined($bg3) ) { $bg3 = $bg2; };

	$out .= <<EOF;
<table border="0" cellpadding="2" cellspacing="0" width="100%">
<tr bgcolor="$bg1">
	<td width="1%">&nbsp;</td>
	<td width="98%" align="center">
		<h2>$cap</h2>
	</td>
	<td width="1%">&nbsp;</td>
</tr>
<tr bgcolor="$bg2">
	<td width="1%">&nbsp;</td>
	<td width="98%">
EOF
	if( defined($key) ) {
		$out .= <<EOF;
		<table border="0" cellpadding="2" cellspacing="0" width="100%">
EOF
		$lop = 0;
		foreach $item ( sort keys %{ $key } ) {
			$fel = (defined($key->{$item}) ? $key->{$item} : 'NULL' );

			if( ($lop = !$lop) == 0 ) {
				$bgtemp = $bg2;
			} else {
				$bgtemp = $bg3;
			};

			$out .= <<EOF;
<tr bgcolor="$bgtemp">
	<td width="1%" nowrap valign="top">
		<b>$item</b>&nbsp;
	</td>
	<td width="99%" valign="top">
		<i>'$fel'</i>
	</td>
</tr>
EOF
		};
		$out .= <<EOF;
		</table>
EOF
	} else {
		my ($temp) = &Quote($extra);
		$out .= <<EOF;
		<blockquote>
			'$temp'
		</blockquote>
EOF
	};
	
	$out .= <<EOF;
	</td>
	<td width="1%">&nbsp;</td>
</tr>
</table>
<br>
EOF
	return $out;
};



sub Quote
{
	my ($str) = @_;
	if( !defined($str) ) { return undef; };
	# hehe, borde quota '&' till '&amp;' oxo, men det är så svårt, den ska ju INTE skära sig med de andra quote-ningarna....
	$str =~ s/å/&aring;/g;
	$str =~ s/Å/&Aring;/g;
	$str =~ s/ä/&auml;/g;
	$str =~ s/Ä/&Auml;/g;
	$str =~ s/ö/&ouml;/g;
	$str =~ s/Ö/&Ouml;/g;
	return $str;
};

sub Encode
{
	my ($in) = @_;
	$in =~ s/([^$ENCODE_EXCEPT])/sprintf("%%%02X",ord($1))/ge;
	return $in;
};

sub Decode
{
	my ($string) = @_;
	$string =~ s/%([a-fA-F0-9]{1,2})/pack("C",hex($1))/ge;
	return $string;
};


sub GetData
{
	my (%user_data,$user_string,$name_value_pair,@name_value_pairs,$name,$value);

	if( defined($ENV{'REQUEST_METHOD'}) ) {
		if( $ENV{'REQUEST_METHOD'} eq "POST" ) {
			read(STDIN,$user_string,$ENV{'CONTENT_LENGTH'});
			$user_string =~ s/\+/ /g;
			@name_value_pairs = split(/$DELIMETER|&/, $user_string);  # All browsers seems to send & as delimeter on POST.
		} else {
			$user_string = $ENV{'QUERY_STRING'};
			$user_string =~ s/\+/ /g;
			@name_value_pairs = split(/$DELIMETER|&/, $user_string);
		};

		foreach $name_value_pair ( @name_value_pairs ) {
			($name,$value) = split(/=/, $name_value_pair);

			$user_data{&Decode($name)} = &Decode($value);
		};
	};
	return %user_data;
};