Initial commit.
This commit is contained in:
eleksir
385
p.pl
Executable file
385
p.pl
Executable file
@@ -0,0 +1,385 @@
|
||||
#!/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;
|
||||
my $minlen = 3;
|
||||
my $maxlen = 9;
|
||||
|
||||
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;
|
||||
# url key length should be 3-9 symbols
|
||||
|
||||
my $urllen = int(rand ($maxlen - $minlen)) + $minlen;
|
||||
for(my $i = 0;$i < $urllen; $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__
|
||||
|
||||
Reference in New Issue
Block a user