Initial commit.
This commit is contained in:
eleksir
315
shorten2.pl
Executable file
315
shorten2.pl
Executable file
@@ -0,0 +1,315 @@
|
||||
#!/usr/bin/perl
|
||||
# vim: set ft=perl ts=8 sw=8 sts=8 ai et :
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
use Fcntl;
|
||||
|
||||
use BerkeleyDB;
|
||||
|
||||
use CGI qw/:standard/;
|
||||
use CGI::Carp 'fatalsToBrowser';
|
||||
$CGI::POST_MAX=1024 * 2; # max 2K posts
|
||||
$CGI::DISABLE_UPLOADS = 1; # no uploads
|
||||
|
||||
my $datapath = '/var/www/s.dafuq.ru/data/';
|
||||
my $db = $datapath . '/short.links.bdb';
|
||||
my $tsdb = $datapath . '/timestamps.bdb';
|
||||
my $expiresdb = $datapath . '/expires.bdb';
|
||||
|
||||
my $str = '';
|
||||
my $url;
|
||||
my $hostname = $ENV{'HTTP_HOST'};
|
||||
my $ts = time();
|
||||
|
||||
sub indexpage($);
|
||||
sub _initdb($);
|
||||
sub initdb();
|
||||
sub http200($);
|
||||
sub http400($);
|
||||
sub http404($);
|
||||
sub http500($);
|
||||
sub genlinkname();
|
||||
sub _urldecode($);
|
||||
|
||||
my ($dbh, $tsdbh, $expdbh) = initdb();
|
||||
|
||||
if ((defined($ARGV[0])) and ($ARGV[0] ne 'index.html')){ # some web-servers add index page, quirk it
|
||||
# we got GET req. here, so let's redirect it.
|
||||
my $status = $dbh->db_get($ARGV[0], $url);
|
||||
|
||||
if ($status == 0) {
|
||||
my $expires;
|
||||
$status = $expdbh->db_get($ARGV[0], $expires);
|
||||
|
||||
if ($status != 0){
|
||||
# expires time stamp missing
|
||||
$expires = $ts + (60*60*24*3*6);
|
||||
$expdbh->db_put($ARGV[0], $expires);
|
||||
}
|
||||
|
||||
if($ts > $expires){
|
||||
http404("Link expired. ts = $ts, expires = $expires");
|
||||
}
|
||||
|
||||
syswrite STDOUT, redirect($url);
|
||||
exit 0;
|
||||
} else {
|
||||
http404("Link not exist.");
|
||||
}
|
||||
|
||||
}else{
|
||||
# we got page/form request, or post link request
|
||||
|
||||
if($ENV{'REQUEST_METHOD'} eq 'POST'){ # post link request
|
||||
# here we need to extract the link
|
||||
my $buf = _urldecode(param('exs'));
|
||||
|
||||
if(($buf =~ /^http:/) or
|
||||
($buf =~ /^https:/) or
|
||||
($buf =~ /^ftp:/) or
|
||||
($buf =~ /^xmpp:/) or
|
||||
($buf =~ /^ipp:/) or
|
||||
($buf =~ /^ldap:/) or
|
||||
($buf =~ /^ldaps:/) or
|
||||
($buf =~ /^irc:/) or
|
||||
($buf =~ /^ircs:/) or
|
||||
($buf =~ /^ssh:/) or
|
||||
($buf =~ /^svn:/) or
|
||||
($buf =~ /^git:/) or
|
||||
($buf =~ /^hg:/) or
|
||||
($buf =~ /^rtmp:/) or
|
||||
($buf =~ /^rtsp:/) or
|
||||
($buf =~ /^rtp:/) or
|
||||
($buf =~ /^shoutcast:/) or
|
||||
($buf =~ /^icecast:/) or
|
||||
($buf =~ /^mailto:/) or
|
||||
($buf =~ /^smb:/) or
|
||||
($buf =~ /^magnet:/) or
|
||||
($buf =~ /^ed2k:/) or
|
||||
($buf =~ /^skype:/) or
|
||||
($buf =~ /^dav:/) or
|
||||
($buf =~ /^h323:/) or
|
||||
($buf =~ /^rsync:/) or
|
||||
($buf =~ /^sftp:/)){
|
||||
}else{
|
||||
http400('Invalid url.');
|
||||
}
|
||||
|
||||
my $name = genlinkname;
|
||||
|
||||
$dbh->db_put($name, $buf);
|
||||
$tsdbh->db_put($name, $ts);
|
||||
|
||||
my $ets = $ts + (60 * 60 * 24 * 30 * 6);
|
||||
my $etime = param('etime');
|
||||
|
||||
if (defined($etime)){
|
||||
if ($etime == '1'){
|
||||
$ets = $ts + (60*60); # 1 hour
|
||||
}elsif ($etime == '2'){
|
||||
$ets = $ts + (60*60*12); # 12 hours
|
||||
}elsif ($etime == '3' ){
|
||||
$ets = $ts + (60*60*24); # 1 day
|
||||
}elsif ($etime == '4' ){
|
||||
$ets = $ts + (60*60*24*7); # 1 week
|
||||
}elsif ($etime == '5' ){
|
||||
$ets = $ts + (60*60*24*30); # 1 month
|
||||
}elsif ($etime == '6' ){
|
||||
$ets = $ts + (60*60*24*30*3); # 3 months
|
||||
}elsif ($etime == '7' ){
|
||||
$ets = $ts + (60*60*24*30*6); # 6 months
|
||||
}elsif ($etime == '8' ){
|
||||
$ets = $ts + (60*60*24*30*12); # 1 year
|
||||
}elsif ($etime == '9' ){
|
||||
$ets = $ts + (60*60*24*30*24); # 2 years
|
||||
}elsif ($etime == '10' ){
|
||||
$ets = $ts + (60*60*24*30*36); # 3 years
|
||||
}
|
||||
}
|
||||
$expdbh->db_put($name, $ets);
|
||||
# here we need to post form with extracted link or just string
|
||||
|
||||
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( |\/)/ )){
|
||||
indexpage("http://$hostname/$name");
|
||||
}
|
||||
}
|
||||
|
||||
http200("http://$hostname/$name");
|
||||
}else{
|
||||
# we got form request with GET/HEAD method, so print it
|
||||
indexpage('');
|
||||
}
|
||||
}
|
||||
|
||||
exit 0;
|
||||
|
||||
sub indexpage($){
|
||||
my $str = shift;
|
||||
syswrite STDOUT, <<DATA
|
||||
Pragma: no-cache
|
||||
Cache-Control: no-cache
|
||||
Content-Language: en, ru
|
||||
Content-type: text/html
|
||||
|
||||
<!DOCTYPE html>
|
||||
<html lang="ru">
|
||||
<head>
|
||||
<meta charset="UTF-8" />
|
||||
<style>
|
||||
* {
|
||||
margin: 10px;
|
||||
text-align: center;
|
||||
font-size: 14pt;
|
||||
}
|
||||
html, body {
|
||||
background-color: #adc0fc;
|
||||
}
|
||||
</style>
|
||||
<title>SlackPaste</title>
|
||||
</head>
|
||||
<body>
|
||||
<img src="http://img.dafuq.ru/logo.png" />
|
||||
|
||||
<form method="post" action="/">
|
||||
Shorten this link:<br />
|
||||
<input type="text" size="30" maxlength="768" name="exs" style="font-size: 110%;" autofocus/></br />
|
||||
<input type="submit" value="Submit" style="font-size: 85%;" />
|
||||
<select name="etime" style="font-size: 85%; text-align:left;">
|
||||
<option value="1" style="font-size: 85%; text-align:left;">1 Hour</option>
|
||||
<option value="2" style="font-size: 85%; text-align:left;">12 Hours</option>
|
||||
<option value="3" style="font-size: 85%; text-align:left;">1 day</option>
|
||||
<option value="4" style="font-size: 85%; text-align:left;">1 week</option>
|
||||
<option value="5" style="font-size: 85%; text-align:left;">1 Month</option>
|
||||
<option value="6" style="font-size: 85%; text-align:left;">3 Months</option>
|
||||
<option value="7" selected style="font-size: 85%; text-align:left;">6 Months</option>
|
||||
<option value="8" style="font-size: 85%; text-align:left;">1 Year</option>
|
||||
<option value="9" style="font-size: 85%; text-align:left;">2 Years</option>
|
||||
<option value="10" style="font-size: 85%; text-align:left;">3 Years</option>
|
||||
</select>
|
||||
</form>
|
||||
DATA
|
||||
;
|
||||
if((defined($str)) and ($str ne '')) { syswrite STDOUT, "<p>$str</p>"; }
|
||||
syswrite STDOUT, <<DATA
|
||||
</body>
|
||||
</html>
|
||||
|
||||
DATA
|
||||
;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
sub _initdb($){
|
||||
my $db = shift;
|
||||
my $dbh = undef;
|
||||
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 initdb(){
|
||||
my @array;
|
||||
foreach($db, $tsdb, $expiresdb){
|
||||
push @array, _initdb($_);
|
||||
}
|
||||
return @array;
|
||||
}
|
||||
|
||||
sub http200($){
|
||||
my $str = shift;
|
||||
syswrite STDOUT, header(-"Cache-Control"=>"no-store, no-cache, must-revalidate",
|
||||
-pragma => "no-cache",
|
||||
-type => "text/plain", -charset => "utf-8") . $str;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
sub http400($){
|
||||
my $str = shift;
|
||||
syswrite STDOUT, "Status: 400 Bad Request
|
||||
Content-type: text/plain
|
||||
|
||||
$str
|
||||
";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
sub http404($){
|
||||
my $str = shift;
|
||||
syswrite STDOUT, "Status: 404 Not Found
|
||||
Content-type: text/plain
|
||||
|
||||
$str
|
||||
";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub genlinkname(){
|
||||
my $count = 0;
|
||||
my $name = '';
|
||||
my $status = 1;
|
||||
# make collision possibility minimal :)
|
||||
do {
|
||||
last if($count > 1000);
|
||||
|
||||
# it should'a be really big amount of links :)
|
||||
my $nlen = (int rand 6) + 3;
|
||||
for(my $i = 0; $i < $nlen; $i++){
|
||||
$name .= ('a'..'z', 'A'..'Z')[int rand length(join('',('a'..'z', 'A'..'Z')))];
|
||||
}
|
||||
$status = $dbh->db_get($name, undef);
|
||||
$count++;
|
||||
} unless ($status == 0);
|
||||
http400('Namespace exhausted.') if($status == 0);
|
||||
return $name;
|
||||
}
|
||||
|
||||
sub _urldecode($){
|
||||
my $string = shift;
|
||||
$string =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
|
||||
return $string;
|
||||
}
|
||||
__END__
|
||||
|
||||
По сравнению с оргинальной версией сделано:
|
||||
Чистка кода,
|
||||
Перевод кода на CGI.pm, всё ровно в последствии надо будет извлекать несколько параметров из POST-а
|
||||
реализация мех-ма со сроком хранения ссылок
|
||||
реализация web-api для выбора предопределённых периодов хранения
|
||||
|
||||
|
||||
<!DOCTYPE HTML>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<title>Exs URL Shortner.</title>
|
||||
</head>
|
||||
<body>
|
||||
<form method="post" action="/s/">
|
||||
<p style="text-align: center;"><b>URL Shortner</b></p>
|
||||
<div style="text-align: center;"><input type="text" size="30" maxlength="256" name="exs" style="font-size:125%;"></div>
|
||||
<p style="text-align: center;"><input type="submit" value="Shorten!"></p>
|
||||
</form>
|
||||
</body>
|
||||
</html>
|
||||
Reference in New Issue
Block a user