#!/usr/bin/perl

=pod

=head1 NAME 

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

$Revision: 1.13 $


=head1 LICENSE

upload is free, gratis and open source software cover by
the DO WHAT THE FUCK YOU WANT TO Public License. 
See the COPYING file included in the distribution 
or the web site http://sam.zoy.org/wtfpl/

=head1 AUTHOR

Gilles LAMIRAL <lamiral@linux-france.org>

Feedback good or bad is often welcome.

$Id: upload,v 1.13 2010/10/10 06:39:23 gilles Exp gilles $

=cut

use warnings;
use strict;

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;
my $url_prefix;

if (-d "/home/lf/html/www.linux-france.org/depot") {
	$dir_prefix = "/home/lf/html/www.linux-france.org/depot/";
	$url_prefix = "depot";
}else{
	$dir_prefix = "/var/www/depot/";
	$url_prefix = "depot";
}

# Nothing to change after this.

my $debug = 0;

my $r = CGI->new;

if (! -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 : $!";

my $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_list_links;

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()) {
	my $tempdir;
	my $tempdir_base;
	my $filename;
	my $file_upload;
	my $buffer;
	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;