#!/usr/bin/perl -w

=pod

=head1 NAME 

upload - CGI script to upload files anonymously on a web server.

$Revision: 1.9 $


=head1 LICENSE

upload is free, gratis and open source software cover by
the GNU General Public License. See the GPL file included in
the distribution or the web site
http://www.gnu.org/licenses/licenses.html

=head1 AUTHOR

Gilles LAMIRAL <lamiral@linux-france.org>

Feedback good or bad is always welcome.

$Id: upload,v 1.9 2007/10/19 04:18:39 gilles Exp gilles $

=cut

use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Time::localtime;
use File::Temp qw/ tempfile tempdir /;
use File::Basename;
use URI::Escape;

$CGI::DISABLE_UPLOADS = 0;

my $dir_prefix = "/var/www/depot/";
#my $dir_prefix = "/home/lf/glamiral/html/prj/upload/depot/";

my $url_prefix = "depot";
#my $url_prefix = "~glamiral/prj/upload/depot";

# Nothing to change after this.

my $debug = 0;

$r = CGI->new;

unless (-d $dir_prefix) {
	mkdir($dir_prefix) or die "can not mkdir $dir_prefix : $!";
}

# check writable dir
-w $dir_prefix or die "Not writable $dir_prefix : $!";

$tm = localtime;
my $date = sprintf("%04d_%02d_%02d", ($tm->year)+1900, ($tm->mon)+1, $tm->mday);
my $dir_date = "$dir_prefix/$date";


my @page_head;
my @page_form;
my @page_result;
my @page_historic;
my @page_end;

my $netloc = $r->url(-base => 1);
$netloc =~ s¤(.*://.*?)/.*¤$1¤; # lfo bug, old very CGI.pm (-base unknown)

$debug and push(@page_form, "\nnetloc : [$netloc]<br>\n");
push(@page_form,
	"Entrez le chemin du fichier que vous désirez déposer sur le serveur :", 
	$r->br,"\n",
	$r->start_multipart_form,
	$r->filefield(-name=>'file',
		      -size=>72,
		      -maxlength=>256,
	  	      ), $r->br,"\n",
	  "Puis cliquez sur le bouton \"Envoi\" pour lancer le dépot :\n",
	$r->submit(-name=>'button_name',
		   -value=>'Envoi'),"\n",
	$r->end_form,"\n",
	$r->hr,"\n",
);

# recup cookie

my @url_list = $r->cookie('url_list');

my $url_len = length("$netloc/$url_prefix/");
foreach my $link (@url_list) {
	my $url_right = substr($link, $url_len);
	my $url_right_unesc = uri_unescape($url_right);
	$debug and push(@page_historic, $url_right_unesc, "<br>\n");
	
	if (-r "$dir_prefix/$url_right_unesc") {
		# exits so write as a link
		push(@url_list_links, $r->a({href=>"$link"},"$link", "<br>\n"));
	} else {
		# no link
		# push(@url_list_links, "$link", "<br>\n");
	}
}

push(@page_historic, 
	"Liste de vos précédents dépôts : <br>\n",
	@url_list_links
	) if (@url_list);

if ($r->param()) {
	
	unless (-d $dir_date) {
		mkdir($dir_date) or die("can not mkdir $dir_date : $!");
	}
	my $index_html = "$dir_date/index.html";
	open (INDEX_HTML,">$index_html") or die "Can not create $index_html: $!";
	print INDEX_HTML "Coucou !\n" ;
	close INDEX_HTML;

	$tempdir = tempdir("XXXXXX", DIR =>  $dir_date) 
		or  die "can not mkdir temp : $!";
	$tempdir_base = basename($tempdir);

	$debug and push(@page_result, $tempdir, $r->br,"\n",
		$tempdir_base);


	$filename    = $r->param('file');
	$file_upload = $r->upload('file');
        # copy
	if ($filename =~/.*\\(.*)$/) {
		# windows
		$filename=$1;}
	else {
		
	}
	my $file_output = "$tempdir/$filename";
	
	if($file_upload) {
		open (OUTFILE,">$file_output");
		while (read($file_upload, $buffer, 1024)) {
        		print OUTFILE $buffer;
         	}
		close OUTFILE;
		
	}
	if($filename) {
		push(@page_result, $r->h3("Résultats"));
		my $url_dir      = join("", $netloc, "/$url_prefix", "/$date", "/$tempdir_base");
		my $filename_esc = uri_escape($filename);
		my $url     = "$url_dir/$filename_esc";
		$debug and push(@page_result, 
			"Chemin sur le serveur : ", $file_output, $r->br,"\n",
			
		);
		sub aere {
			my $texte = reverse $_[0];
			$texte =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1 /g;
			return scalar reverse $texte;
		}
		my $filesize = aere(-s $file_output);
		push(@page_result, 
			"Veuillez copier le texte suivant et le coller dans le courriel ",
			"destiné aux personnes devant télécharger le fichier.",$r->hr,
			"Bonjour, ", $r->p, "\n",
			"Le fichier <b>$filename</b> ",
			"($filesize octets)",
			" est maintenant disponible dans le dossier ci-dessous : ", $r->br,"\n",
			$r->a({href=>"$url_dir/"},"$url_dir/"), $r->br,"\n",
			"ainsi qu'à l'adresse suivante : ", $r->br,"\n",
			$r->a({href=>"$url"},"$url"), $r->br,$r->br ,"\n",
			$r->hr
		);
		unshift(@url_list, "$url");
	}
	
	
	
}

# set cookie
my $cookie = $r->cookie(
			-name=>'url_list',
			-value=>\@url_list,
			-expires=>"+1y"
);

push(@page_head, 
	$r->header(-cookie=>$cookie, -expires=>'+1y'),"\n",
	$r->start_html('Dépot de fichier'),"\n",
	$r->h3("Dépot de fichier sur le serveur $netloc/"),
);

# Uncomment @page_historic if you want users see the history 
# of their uploads
print 	@page_head, 
	@page_form,
	@page_result,
	#@page_historic,
	$r->end_html;