382 lines
9.5 KiB
Perl
Executable File
382 lines
9.5 KiB
Perl
Executable File
#!/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> 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__
|
|
|