#! /usr/local/bin/perl

use CGI;
use CGI::Cookie;
use File::Copy;
use File::Basename;
use Digest::SHA1 qw(sha1_hex);
use Time::HiRes qw(gettimeofday);
use Data::Dumper;

## おまじない。100K 以上のデータは破棄する
$CGI::POST_MAX = 1024 * 100;
my $q = CGI->new;

## upload 画面 or upload ファイル処理
if ( $q->param('uploadfile') ) {
    _uploadfile($q);
}
else {
    _init($q);
}

sub _uploadfile {
    my $q = shift;
    eval {
        ## file upload 処理
        my $upload_dir = './tmp/';
        my $fh         = $q->upload('uploadfile');

        ## 異常処理
        if ( $q->cgi_error ) {
            print $q->header( -type => 'text/html', -charset => 'UTF-8' );
            print "failed: Request entity too large'";
            exit;
        }
        unless ($fh) {
            print $q->header( -type => 'text/html', -charset => 'UTF-8' );
            print "failed: no data";
            exit;
        }

        ## コンテンツ処理。とりあえずファイルを所定の場所に移動
        my $temp_path = $q->tmpFileName($fh);
        fileparse_set_fstype('MSDOS');
        my $filename    = basename($fh);
        my $upload_path = "$upload_dir/$filename";
        move( $temp_path, $upload_path ) or die $!;
        close($fh);

        ## まぁファイルをためられても困るので、サンプルではとりあえず削除
        my $filesize = -s $upload_path;
        unlink $upload_path;

        ## cookie 処理
        my $sid_name  = 'sessionid';
        my $sessionid = $q->cookie($sid_name);
        my $cookiebug = $q->param("cookiebug");

        ## cookie bug 対応
        ## SWFuploader 経由のアクセスならば post データから sessionid を上書きする
        if ( $cookiebug && $ENV{HTTP_USER_AGENT} =~ /^(Adobe|Shockwave) Flash/ ) {
            $sessionid = $q->param($sid_name);
        }

        ## sessionid がない場合には sessionid を生成する
        if ( !$sessionid ) {
            $sessionid = _gen_sessionid();
        }

        ## テストのために cookie を送り込む
        my $cookie = $q->cookie( -name => $sid_name, -value => $sessionid );
        print $q->header( -type => 'text/html', -charset => 'UTF-8', -cookie => [$cookie] );
        print "sessionid=$sessionid / filesize=$filesize byte";

        open my $lfh, '>>', 'log.txt';
        print $lfh "$sessionid,$ENV{HTTP_USER_AGENT}\n";
        print $lfh $q->param($sid_name), "\n";
        print $lfh $q->param("cookiebug"), "\n";

        #print $lfh Dumper $q;
        print $lfh Dumper $cookie;
        close $lfh;

    };

    if ($@) {
        open my $lfh, '>>', 'log.txt';
        print $lfh "$@\n";
        close $lfh;
    }
}

sub _init {
    my $q = shift;

    ## html template
    open my $fh, '<', 'index.txt';
    my $text = do { local $/; <$fh> };
    close $fh;

    ## cookie 処理
    my $sid_name  = 'sessionid';
    my $sessionid = $q->cookie($sid_name);

    ## sessionid がない場合には sessionid を生成する
    $sessionid = _gen_sessionid();

    ## html 出力
    $text =~ s/\$sessionid\$/$sessionid/msxg;
    my $cookie = $q->cookie( -name => $sid_name, -value => $sessionid );
    print $q->header( -type => 'text/html', -charset => 'UTF-8', -cookie => [$cookie] );
    print $text;

}

sub _gen_sessionid {
    my $ipaddr
        = defined( $ENV{'HTTP_X_FORWARDED_FOR'} ) ? $ENV{'HTTP_X_FORWARDED_FOR'}
        : defined( $ENV{'REMOTE_ADDR'} )          ? $ENV{'REMOTE_ADDR'}
        :                                           '255.255.255.255';
    my $unique = $ipaddr . rand();
    my $sessionid = substr( sha1_hex( gettimeofday . $unique ), 0, 32 );
    return $sessionid;
}