1
Files
misc/shorten.old.pl
2018-05-23 14:48:37 +03:00

196 lines
4.3 KiB
Perl

#!/usr/bin/perl
# simple link shortner
# implemented as tied hash
use strict;
use warnings "all";
use Fcntl;
use Storable;
#use CGI::Carp qw/fatalsToBrowser/;
my $db = '/tmp/short.links.db';
my $str = '';
my $maxlinklength = 2048;
my %link;
my $name = '';
my $i;
if (defined($ARGV[0])){
# we got GET req. here, so let's redirect it.
%link = %{retrieve("$db")};
if (defined($link{$ARGV[0]})){
$str = sprintf("Status: 302 Found
Location: %s
%s", $link{"$ARGV[0]"}, $link{"$ARGV[0]"});
} else {
$str = "Status: 200 OK
Content-type: text/plain
Link expired.
";
}
}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
for($i = 0; $i < 5; $i++){
$name .= ('a'..'z', 'A'..'Z')[int rand length(join('',('a'..'z', 'A'..'Z')))];
}
my $buf = '';
if(defined($ENV{'CONTENT_LENGTH'})){
if($ENV{'CONTENT_LENGTH'} < $maxlinklength) {
sysread(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
if(substr($buf, 0, 3) eq 'exs'){
if(($buf =~ /^exs=http%3A/) or
($buf =~ /^exs=https%3A/) or
($buf =~ /^exs=ftp%3A/) or
($buf =~ /^exs=xmpp%3A/) or
($buf =~ /^exs=ipp%3A/) or
($buf =~ /^exs=ldap%3A/) or
($buf =~ /^exs=ldaps%3A/) or
($buf =~ /^exs=irc%3A/) or
($buf =~ /^exs=ircs%3A/) or
($buf =~ /^exs=ssh%3A/) or
($buf =~ /^exs=svn%3A/) or
($buf =~ /^exs=git%3A/) or
($buf =~ /^exs=hg%3A/) or
($buf =~ /^exs=rtmp%3A/) or
($buf =~ /^exs=rtsp%3A/) or
($buf =~ /^exs=rtp%3A/) or
($buf =~ /^exs=shoutcast%3A/) or
($buf =~ /^exs=icecast%3A/) or
($buf =~ /^exs=mailto%3A/) or
($buf =~ /^exs=smb%3A/) or
($buf =~ /^exs=magnet%3A/) or
($buf =~ /^exs=ed2k%3A/) or
($buf =~ /^exs=skype%3A/) or
($buf =~ /^exs=dav%3A/) or
($buf =~ /^exs=h323%3A/) or
($buf =~ /^exs=rsync%3A/) or
($buf =~ /^exs=sftp%3A/)){
$buf = substr($buf, 4);
}else{
syswrite STDOUT, "Status: 400 Bad Request
Content-type: text/plain
Invalid url.
";
exit 0;
}
}else{
syswrite STDOUT, 'Status: 400 Bad Request
Content-type: text/plain
Invalid parameter.
';
exit 0;
}
}else{
syswrite STDOUT, 'Status: 400 Bad Request
Content-type: text/plain
Link too long.';
exit 0;
}
}else{
syswrite STDOUT, 'Status: 400 Bad Request
Conten-type: text/plain
CONTENT_TYPE env. var. required
';
exit 0;
}
# create db file if it is absent
unless( -f "$db"){
sysopen(FILE, "$db", O_WRONLY|O_TRUNC|O_CREAT);
close FILE;
# save empty hash to init structure
store \%link, $db;
}
# decode it :(
$buf =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
%link = %{retrieve($db)};
$link{$name} = $buf;
store \%link, $db;
# here we need to post form with extracted link or just string
$str .= "Status: 200 OK
Content-type: text/plain
http://s.dafuq.ru/$name
";
}else{ # we got form request with get/head method, so print it
$str .= '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>exs-elm.ru</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="256" name="exs" style="font-size: 110%;"/></br />
<input type="submit" value="Submit" style="font-size: 85%;" />
</form>
</body>
</html>
';
}
}
syswrite STDOUT, $str;
exit 0;
__END__
всего 3 типа запросов
-на показ формы
-на аплод ссылки из формы/аплоад ссылки из ком.строки
-на редирект по ссылке
<!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>