#!/usr/bin/perl
#
# $Id: upload.cgi,v 1.11 2008/05/17 07:00:42 suter Exp $
# Copyright (C) 2001,2002,2004,2007 Mark Suter <suter@humbug.org.au>
#
# This file is part of Upload.
#
# Upload is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# [MJS 22 May 2001] Initial version.
# [MJS 24 Oct 2002] Added some explanatory text.
# [MJS 19 Jun 2004] Playing with Authen::Captcha.
# [MJS  4 Dec 2007] Added status bar, cleaned up code and moved to GLPv3.

use strict;
use warnings;
use Authen::Captcha;
use CGI qw( -nosticky -close_upload_files );
use English qw( -no_match_vars );
use File::Copy;
use File::Slurp;
use JSON qw( objToJson );
use JavaScript::Minifier qw( minify );

$CGI::DISABLE_UPLOADS = 0;             ## allow uploads
$CGI::POST_MAX        = 75 * 2**20;    ## max size allowed

## A safe file upload form, to this directory only.
my $dest_dir = '/var/www/zwitterion.org/test';
my $dest_uri = 'http://zwitterion.org/test';

## Initialize our CGI object, parsing a ProgressID manually if present.
$OUTPUT_AUTOFLUSH++;
my $q = undef;
if ( $ENV{QUERY_STRING} =~ m{ pid = ( [0-9a-f]+ ) }ix ) {
    $q = CGI->new(
        \&upload_cb,
        {   start    => time(),
            unit     => 'KB/s',
            divisor  => 1000,
            file     => "$dest_dir/.status-$1",
            total    => $ENV{'CONTENT_LENGTH'},
            done     => 0,
            activity => time(),
        }
    );
}
else {
    $q = CGI->new();
}

## Ready our captcha engine
my $captcha = Authen::Captcha->new(
    data_folder   => "$dest_dir/.captcha-db",
    output_folder => "$dest_dir/.captcha",
    width         => 30,
    height        => 40
) or die;
my ( $md5sum, $captcha_code ) = $captcha->generate_code(5);

## Start the page
print $q->header( -type => 'text/html', -expires => 'now' ),
    $q->start_html(
    -title  => 'Test File Upload',
    -style  => { 'src' => [ '/style.css', 'upload.css' ] },
    -author => 'suter@humbug.org.au',
    -head   => [
        $q->meta(
            {   -http_equiv => 'Content-Script-Type',
                -content    => 'text/javascript'
            }
        ),
        CGI::Link( { -rel => 'shortcut icon', -href => '/favicon.ico' } ),
    ],
    -script => {
        -type => 'text/javascript',
        -code => javascript( "$dest_dir/upload.js", $captcha_code )
    }
    ),
    '<div id="content">',
    $q->h1('Test File Upload');

## Process parameters
if ( $q->param() ) {

    eval {

        ## Carefully get the captcha parameters
        my $md5sum = $q->param('md5sum') or die "md5sum missing\n";
        my $code   = $q->param('code')   or die "captcha missing\n";
        $md5sum =~ s{ \A ( [0-9a-z]+ ) \Z }{$1}ix or die "regex: $md5sum\n";
        $code   =~ s{ \A ( [0-9a-z]+ ) \Z }{$1}ix or die "regex: $code\n";

        ## Carefully check the captcha
        my $results = $captcha->check_code( $code, $md5sum );
        $results == 0  and die "captcha: not checked (file error)\n";
        $results == -1 and die "captcha: expired\n";
        $results == -2 and die "captcha: not in database\n";
        $results == -3 and die "captcha: does not match\n";
        $results == 1 or die "captcha: unknown failure\n";   ## extra failsafe

        ## Get incoming temporary file's name
        $q->cgi_error() and die $q->cgi_error();
        my ($temp_name)
            = $q->tmpFileName( grep { defined $_ } $q->param('filename') )
            =~ m{ ( .+ ) }x;
        defined $temp_name and -e $temp_name
            or die "Did you select a file ?\n";

        ## Get user-pov filename
        my $filename = $q->param('filename') or die "filename missing\n";
        $filename =~ s{ \A .*? ( [0-9a-z] [-.0-9a-z]{1,31} ) \Z }{$1}ix
            or die "regex: $filename\n";

        ## Get a size
        my $size = -s "$temp_name" or die "stat: $OS_ERROR\n";
        $size gt 0 or die "empty file!\n";

        ## Move the file into place
        move( $temp_name, "$dest_dir/$filename" ) or die "move: $OS_ERROR\n";

        ## Announce success
        print $q->p(
            "Uploaded <a href=\"$dest_uri/$filename\">$filename</a> ($size bytes) - return to <a href=\"$dest_uri/\">$dest_uri/</a>."
        );

    };
    $@ and print $q->p( { class => 'alert' },
        "There was a problem: <strong>$@</strong>" );
    print '</div>', $q->end_html, "\n";

}
else {

    print $q->div(
        { id => 'progress' },
        $q->start_multipart_form(
            -method   => 'POST',
            -action   => $q->self_url(),
            -onSubmit => 'return check_upload(this)'
        ),
        $q->hidden( 'md5sum', $md5sum ),
        $q->p('This upload is offered with these limitations and warnings:'),
        $q->ul(
            $q->li(
                [
                    'Name may be munged: up to 32 letter/number/hyphen/period, starting with letter/number.',
                    sprintf( 'Maximum size is %.1f mebibytes.', $CGI::POST_MAX / 2**20 ),
                    'Removal after 14 days, possibly earlier.',
                    'Files can be overwritten by anyone.',
                    'Files are public - the <a href="' . $dest_uri . '/">test area</a> is public.',
                ]
            )
        ),
        $q->p(
            '<a href="http://en.wikipedia.org/wiki/Captcha">Captcha</a> ',
            "<img src=\"$dest_uri/.captcha/$md5sum.png\" alt=\"$captcha_code\" /> says ",
            $q->textfield( -name => 'code', -size => 5 ),
            $q->hidden( 'md5sum', $md5sum )
        ),
        $q->p(
            $q->filefield(
                -name => 'filename',
                -size => 50,
            )
        ),
        $q->p( { -id => 'errors_upload' }, q{} ),
        $q->p( $q->submit( -name => 'upload', -value => 'Upload' ) ),
        $q->end_form,
        $q->p(
            'Source: <a href="upload.cgi">cgi</a>, <a href="upload.js">js</a> &amp; <a href="upload.css">css</a>.'
        ),
        ),
        '</div>', $q->end_html, "\n";

}

## Upload progress hook - write an updated hash to disk
sub upload_cb {
    my ( undef, undef, $bytes_read, $data ) = @_;
    $data->{done}     = $bytes_read;
    $data->{activity} = time();
    write_json( $data, $data->{file} );
}

## Our JavaScript - checked with http://www.jslint.com/
sub javascript {
    my ( $file, $captcha_code ) = @_;

    my $code = read_file( $file, err_mode => 'carp' )
        or die "open: $OS_ERROR\n";
    $code =~ s{TIME}{ time() }e;
    $code =~ s{CAPTCHA}{$captcha_code};
    $code = minify( input => $code );
    $code =~ s{\s+}{ }g;
    return $code;
}

## Write the given object to the given filename in JSON format
sub write_json {
    my ( $ref, $filename ) = @_;

    ## Convert to JavaScript Object Notation - refer http://json.org/
    my $string = objToJson($ref);

    ## Write in a fashion suitable for many readers
    write_file( $filename, { atomic => 1 }, $string )
        or die "write: $OS_ERROR\n";
}