#!/usr/bin/perl

use strict;
use warnings "all";
use Fcntl;
use BerkeleyDB;

my $str = '';

my $DIR = '/var/www/p.dafuq.ru/paste';
my $TSDB = "$DIR/timestamps.db";
my $DB = "$DIR/data.db";
my $URL = 'http://p.dafuq.ru/';
my $fsize = 262144;

sub initdb();
sub showindex($);
sub eclient();
sub dclient();
sub getpaste($);

my $dbh = initdb();
showindex('') unless (defined($ENV{'REQUEST_METHOD'}));

if ($ENV{'REQUEST_METHOD'} eq 'GET'){
	showindex('') unless (defined($ENV{'QUERY_STRING'}));

	if ($ENV{'QUERY_STRING'} eq 'e'){
		eclient();
	}

	if ($ENV{'QUERY_STRING'} eq 'd'){
		dclient();
	}

	getpaste($ENV{'QUERY_STRING'});

# assume POST(?) request
}elsif($ENV{'REQUEST_METHOD'} eq 'POST'){

	showindex('') unless (defined($ENV{'CONTENT_LENGTH'}));
	showindex('') if ($ENV{'CONTENT_LENGTH'} == '');
	showindex('') if ($ENV{'CONTENT_LENGTH'} > $fsize);
	showindex('') if ($ENV{'CONTENT_LENGTH'} eq '0');

        my $fname;

        for(my $i = 0;$i < 3; $i++){
                $fname .= ('a'..'z', 'A'..'Z')[int rand length(join('',('a'..'z', 'A'..'Z')))];
        }

	if ( $dbh->db_get($fname, undef) == 0 ){
		# looks like we already have value here
		# TODO: check timestamp!
		if ( $dbh->db_del($fname) != 0 ){
			# oops, error... how can it be here?
			$str = 'Status: 500 Application Error
Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain

Application error - unable to delete key in $DB
';
		}
	}
	
        my $c = 0;
        my $delim = '';
        my $header = '';
        my $char = '';

        while(read(STDIN, $char, 1)){
        # looks like this case is obviously sic, but... :)
                if($c >= $ENV{'CONTENT_LENGTH'}){
                        $str = 'Status: 400 Bad Request
Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain

';
                }
                last if ($char eq "\n");
                $delim .= $char;
                $c++;
        }

        read(DATA, $char, 1);

        while(read(STDIN, $char, 1)){
                if($c >= $ENV{'CONTENT_LENGTH'}){
                        $str = 'Status: 400 Bad Request
Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain

';
                }

                last if ($char eq "\n");
                $header .= $char;
                $c++;
        }

        unless ($header =~ /Content-Disposition: form-data; name=.exs./) {
                $str = 'Status: 400 Bad Request
Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain

Form should be multipart and parameter/field should be exs.';
                syswrite STDOUT, $str;
                exit 0;
        }

        read(STDIN, $char, 2);

        my $datalen = $ENV{'CONTENT_LENGTH'} - (length($delim) + 2  + length($header) + 4 + length($delim) + 3);

        my $paste = '';
        read(STDIN, $paste, $datalen);

        # read one nl+cr
        read(STDIN, $char, 1);

        # read last delimiter
        my $checkstr;
        read(STDIN, $checkstr, (length($delim)));

        # compare first delimiter and last one
        chop($delim); chop($checkstr);

        unless ($delim eq $checkstr){
                $str .= 'Status: 400 Bad Request
Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain

';
        }
	
	$dbh->db_put($fname, $paste); # TODO: check status!

# if defined useragent and it doesen't match text browsers/download tools
# show fancy page
	if (defined($ENV{'HTTP_USER_AGENT'})){
		if (not($ENV{'HTTP_USER_AGENT'} =~ /^fetch libfetch/ or
			$ENV{'HTTP_USER_AGENT'} =~ /^curl\// or
			$ENV{'HTTP_USER_AGENT'} =~ /^Wget\// or
			$ENV{'HTTP_USER_AGENT'} =~ /^Axel / or
			$ENV{'HTTP_USER_AGENT'} =~ /^aria2\// or
			$ENV{'HTTP_USER_AGENT'} =~ /^Links \(/ or
			$ENV{'HTTP_USER_AGENT'} =~ /^Elinks( |\/)/ or
			$ENV{'HTTP_USER_AGENT'} =~ /^w3m\// or
			$ENV{'HTTP_USER_AGENT'} =~ /^Lynx( |\/)/ )){
			showindex("$URL$fname");
		}
	}

        $str = "Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain

$URL$fname
";


}else{
# unknown method or commandline call without correct environment
	showindex('');
}

syswrite STDOUT, $str;



sub initdb(){
	my $dbh = undef;	
	unless (-f "$TSDB"){
		$dbh = new BerkeleyDB::Hash(
		        -Filename => $TSDB,
		        -Flags    => DB_CREATE
		)
		or die "Error opening $TSDB : $! $BerkeleyDB::Error\n";
	}else{
		$dbh = new BerkeleyDB::Hash(
		        -Filename => $TSDB,
		)
		or die "Error opening $TSDB : $! $BerkeleyDB::Error\n";
	}

	unless (-f "$DB"){
		$dbh = new BerkeleyDB::Hash(
		        -Filename => $DB,
		        -Flags    => DB_CREATE
		)
		or die "Error opening $DB : $! $BerkeleyDB::Error\n";
	}else{
		$dbh = new BerkeleyDB::Hash(
		        -Filename => $DB,
		)
		or die "Error opening $DB : $! $BerkeleyDB::Error\n";
	}
	return $dbh;
}

sub showindex($){
    my $link = shift;

    my $str = 'Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/html; charset=UTF-8

<!DOCTYPE html>
<html lang="ru">
<head>
        <style>
                body { background-color: #adc0fc; text-align: center; }
                textarea {
                        background-image: url("http://img.dafuq.ru/bg_logo.png");
                        background-repeat: no-repeat;
                        background-position: center center;
                        width: 90%;
                        height: 70vh;
                }
        </style>
        <title>Slack paste.</title>
</head>
<body>
        <h3>Slack Paste</h3>
        <form method="post" action="/" enctype="multipart/form-data">
                <textarea name="exs" id="textbox" autofocus></textarea><br />
                <input type="submit" value="Post it!" style="font-size:115%;" />
        </form>';

	if (defined($link) and $link ne ''){
		$str .= "\n<p><table align=\"center\" frame=\"void\" border=\"0\"><td>$link</td></table></p>";
	}

	$str .= '
        <p style="font-size: small;">
                Console client can be found here: <a href="http://p.dafuq.ru/e">http://p.dafuq.ru/e</a>&nbsp; &nbsp; thanks <a href="http://sprunge.us">sprunge.us</a> for their client :)<br/>
                More minimalist console client can be found here: <a href="http://p.dafuq.ru/d">http://p.dafuq.ru/d</a><br/>
                <br/>
                2015
        </p>
</body>
</html>
';
    syswrite STDOUT, $str;
    exit 0;
}

sub eclient(){
    $str = 'Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain
Content-Disposition: attachment; filename="e";

#!/bin/bash

usage() {
description | fmt -s >&2
}

description() {
cat << HERE

DESCRIPTION
  Upload data and fetch URL from the pastebin http://p.dafuq.ru/

USAGE
  $0 filename.txt
  $0 text string
  $0 < filename.txt
  piped_data | $0

NOTES
--------------------------------------------------------------------------
* INPUT METHODS *
$0 can accept piped data, STDIN redirection [<filename.txt], text strings following the command as arguments, or filenames as arguments.  Only one of these methods can be used at a time, so please see the note on precedence.  Also, note that using a pipe or STDIN redirection will treat tabs as spaces, or disregard them entirely (if they appear at the beginning of a line).  So I suggest using a filename as an argument if tabs are important either to the function or readability of the code.

* PRECEDENCE *
STDIN redirection has precedence, then piped input, then a filename as an argument, and finally text strings as an arguments.

  EXAMPLE:
  echo piped | "$0" arguments.txt < stdin_redirection.txt

In this example, the contents of file_as_stdin_redirection.txt would be uploaded. Both the piped_text and the file_as_argument.txt are ignored. If there is piped input and arguments, the arguments will be ignored, and the piped input uploaded.

* FILENAMES *
If a filename is misspelled or doesn\'t have the necessary path description, it will NOT generate an error, but will instead treat it as a text string and upload it.
--------------------------------------------------------------------------

HERE
exit
}

if [ -t 0 ]; then
  echo Running interactively, checking for arguments... >&2
  if [ "$*" ]; then
    echo Arguments present... >&2
    if [ -f "$*" ]; then
      echo Uploading the contents of "$*"... >&2
      cat "$*"
    else
      echo Uploading the text: \""$*"\"... >&2
      echo "$*"
    fi | curl -F "exs=<-" http://p.dafuq.ru/
  else
    echo No arguments found, printing USAGE and exiting. >&2
    usage
  fi
else
  echo Using input from a pipe or STDIN redirection... >&2
  while read -r line ; do
    echo $line
  done | curl -F "exs=<-" http://p.dafuq.ru/
fi
';
    syswrite STDOUT, $str;
    exit 0;
}

sub dclient(){
    $str = 'Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-type: text/plain
Content-Disposition: attachment; filename="d";

#!/usr/bin/env bash

if [[ "$1" == "--help" ]]; then
        echo "Usage:  $0 < file"
        echo "        echo foo | $0"
elif [[ -f "$1" ]]; then
        curl -F "exs=<-" "http://p.dafuq.ru" <"$1"
else
        curl -F "exs=<-" "http://p.dafuq.ru"
fi

exit 0
';
    syswrite STDOUT, $str;
    exit 0;
}

sub getpaste($){
	my $id = shift;
	my $str = '';
	if ( $dbh->db_get($id, $str) == 0 ){
                $str = "Status: 200 OK
Pragma: no-cache
Cache-Control: no-cache
Content-Language: en, ru
Content-Type: text/plain; charset=UTF-8

$str";
        }else{
		$str = "Status: 404 Not Found
Content-type: text/plain
Pragma: no-cache
Cache-Control: no-cache

No such paste.
";
	}

	syswrite STDOUT, $str;
	exit 0;
}
__END__