From 82b0cfbcc286a14bb6dfd097bf26b684b8e3572f Mon Sep 17 00:00:00 2001
From: eleksir <none@none>
Date: Sat, 3 Sep 2016 22:38:52 +0300
Subject: [PATCH] Initial commit.

---
 copier.pl                 |  27 +++
 cwnd.sh                   |   6 +
 dirlist.pl                |  47 +++++
 dns-hit.pl                |  52 +++++
 dns-tank-mt.pl            | 117 ++++++++++++
 dns-tank-st.pl            |  89 +++++++++
 dnszone-bind2unbound.json |   4 +
 dnszone-bind2unbound.pl   |  46 +++++
 i3status-mt-json          | 291 ++++++++++++++++++++++++++++
 munincurrency             | 140 ++++++++++++++
 muninweather              | 124 ++++++++++++
 p.pl                      | 385 ++++++++++++++++++++++++++++++++++++++
 paste.pl                  | 292 +++++++++++++++++++++++++++++
 paste2.pl                 | 381 +++++++++++++++++++++++++++++++++++++
 rle.pl                    |  86 +++++++++
 shorten.old.pl            | 195 +++++++++++++++++++
 shorten.pl                | 315 +++++++++++++++++++++++++++++++
 shorten2.pl               | 315 +++++++++++++++++++++++++++++++
 unrle.pl                  |  69 +++++++
 wp.pl                     | 101 ++++++++++
 yagecibycocin.pl          |  62 ++++++
 zip_fb2.pl                |  38 ++++
 22 files changed, 3182 insertions(+)
 create mode 100755 copier.pl
 create mode 100755 cwnd.sh
 create mode 100755 dirlist.pl
 create mode 100755 dns-hit.pl
 create mode 100755 dns-tank-mt.pl
 create mode 100755 dns-tank-st.pl
 create mode 100644 dnszone-bind2unbound.json
 create mode 100755 dnszone-bind2unbound.pl
 create mode 100755 i3status-mt-json
 create mode 100644 munincurrency
 create mode 100644 muninweather
 create mode 100755 p.pl
 create mode 100755 paste.pl
 create mode 100755 paste2.pl
 create mode 100644 rle.pl
 create mode 100755 shorten.old.pl
 create mode 100755 shorten.pl
 create mode 100755 shorten2.pl
 create mode 100644 unrle.pl
 create mode 100755 wp.pl
 create mode 100755 yagecibycocin.pl
 create mode 100755 zip_fb2.pl

diff --git a/copier.pl b/copier.pl
new file mode 100755
index 0000000..7463494
--- /dev/null
+++ b/copier.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings "all";
+use File::Copy;
+
+
+my $file;
+my $counter = 1;
+my @list;
+my $curdir = 1;
+mkdir ($curdir);
+opendir (DIR, ".");
+foreach $file (readdir(DIR)){
+next unless ($file =~ /\.zip$/);
+	if($counter == 5000){
+		$counter = 1;
+		$curdir = $curdir + 1;
+		mkdir ($curdir);
+	}
+	my $nefile = $curdir .'/'.$file;
+	print "$file $nefile\n";
+	move($file, $nefile) or die "$!";
+	$counter = $counter + 1;
+}
+closedir (DIR);
+
diff --git a/cwnd.sh b/cwnd.sh
new file mode 100755
index 0000000..5165e71
--- /dev/null
+++ b/cwnd.sh
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+#ip route | while read p; do ip route change $p initcwnd 10 initrwnd 10; done
+ip route | while read p; do ip route change $p initcwnd 10; done
+
+exit 0
diff --git a/dirlist.pl b/dirlist.pl
new file mode 100755
index 0000000..25729b8
--- /dev/null
+++ b/dirlist.pl
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+#
+# slow implementation of recursive dir listing
+#
+
+use strict;
+use warnings "all";
+
+sub getfilenames;
+sub help;
+
+help unless defined($ARGV[0]);
+
+my @files = ();
+getfilenames($ARGV[0]);
+my $file = "";
+
+while($file = pop (@files)){
+        print "$file\n";
+}
+
+exit 0;
+
+sub getfilenames {
+    my $path    = shift;
+
+    opendir (DIR, $path) or return "";
+    my @localfiles;
+    @localfiles =
+        map { $path . '/' . $_ }
+        grep { !/^\.{1,2}$/ }
+        readdir (DIR);
+    @files = (@files, @localfiles);
+
+    foreach (@localfiles) {
+            next if(-l $_);
+            if( -d $_){
+                getfilenames($_);
+            }
+    }
+
+}
+
+sub help {
+        print "Usage: $0 dir\n";
+        exit 0;
+}
diff --git a/dns-hit.pl b/dns-hit.pl
new file mode 100755
index 0000000..dba64f5
--- /dev/null
+++ b/dns-hit.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings "all";
+
+use Net::DNS;
+
+my $record_type = 'TXT';
+my $record_amount = 28;
+my $domain = 'cnn.com';
+
+sub lookup;
+
+my $res = Net::DNS::Resolver->new(
+	nameservers => [ '217.16.16.13', '217.16.20.13', '217.16.16.12', '217.16.22.12' ],
+	recurse     => 1,
+	debug       => 0
+);
+
+my $i = 0;
+while ( 1 ) {
+	my $hit = 0; my $miss = 0;
+
+	for ($i = 0; $i < 1000; $i++) {
+		if (lookup($domain) == 1){ $miss++; }
+		else { $hit++; }
+	}
+
+	print "hit/miss: $hit/$miss\n";
+}
+exit 0;
+
+sub lookup {
+	my $host = shift;
+	my $reply = $res->query($host, $record_type);
+
+	if (defined($reply)) {
+		my $rec_count = 0;
+
+		foreach my $rr ($reply->answer) {
+			next if ($rr->type ne $record_type);
+			$rec_count++;
+		}
+
+		return 1 if ($rec_count < $record_amount);
+		return 0;
+	} else {
+#		warn "query failed: ", $res->errorstring, "\n";
+		return 1;
+	}
+}
+
diff --git a/dns-tank-mt.pl b/dns-tank-mt.pl
new file mode 100755
index 0000000..dc63100
--- /dev/null
+++ b/dns-tank-mt.pl
@@ -0,0 +1,117 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings "all";
+
+use Net::DNS;
+use threads;
+use threads::shared;
+
+my $max_sleep = 2000;         # max sleep between sequental lookups 2 seconds long
+my $max_burst_lookups = 15;   # max amount of lookup without delay
+my $threads_max = 310;        # on my vm threads gonna die if amount more than 313, seems like some pthread limit?
+my @nameservers = ('192.168.88.2');
+
+my $domfile = 'domfile.txt';  # file format: domainname record_type number_of_values
+                              # num_of_values can be -1 if no A record exist
+sub worker;                   # main sub of worker
+sub lookup;                   # hotpath :)
+sub nodomlist;
+sub usleep;                   # millisecond sleep, 1000 milliseconds = 1 second
+
+nodomlist() unless ( -f $domfile );
+
+my $res;
+
+my @list;
+open (LIST, $domfile) or die ("Unable to read $domfile");
+
+while (<LIST>){
+	next if (($_ eq '') or ($_ =~ /^\s*#/));
+	chomp($_); chomp($_);
+	push @list, $_;
+}
+
+close LIST;
+
+# TODO: looks like this stuff should be created on per thread basis, not shared
+
+my @threads;
+for (my $m = 1; $m <= $threads_max; $m++){
+	push @threads, threads->create('worker');
+	syswrite STDOUT, "thread $m/$threads_max spawned\r";
+	usleep('10');
+}
+
+syswrite STDOUT, "\n";
+
+# we'll wait forever 'till threads' exit :)
+foreach my $thread (@threads){ $thread->join(); }
+
+exit 0;
+
+
+sub worker {
+	threads->yield();
+
+	$res = Net::DNS::Resolver->new(
+		nameservers => [ @nameservers ],
+		recurse     => 1,
+		debug       => 0
+	);
+
+	my $lookup_cnt = int(rand($max_burst_lookups));
+	while ( 1 ) {
+		my $ok = 0; my $error = 0;
+
+		for (my $i = 0; $i < 10000; $i++) {
+
+			if ($lookup_cnt <= 0){
+				usleep(int(rand($max_sleep)));
+				$lookup_cnt = int(rand($max_burst_lookups));
+			} else {
+				$lookup_cnt--;
+			}
+
+			my ($domain, $record_type, $amount) = split(/\s+/, $list[int(rand(@list))]);
+			my $result = lookup($domain, $record_type);
+
+			if (defined($result) and ($result == $amount)){ $ok++; }
+			elsif (($amount == -1) and ($result == undef)){ $ok++; }
+			else { $error++; }
+		}
+
+		syswrite STDOUT, "Success/Error: $ok/$error\n";
+	}
+	return 0; # we'll never return :(
+}
+
+sub lookup {
+	my $host = shift;
+	my $type = shift;
+	my $rec_count = 0;
+	my $reply = $res->query($host, $type);
+
+	if (defined($reply)) {
+
+		foreach my $rr ($reply->answer) {
+			$rec_count++ if ($rr->type eq $type);
+		}
+
+		return $rec_count;
+	} else {
+#		warn "query failed: ", $res->errorstring, "\n";
+		return undef;
+	}
+}
+
+sub nodomlist {
+	print "Unable to find $domfile\n";
+	exit 1;
+}
+
+sub usleep {
+	my $delay = shift;
+	select(undef, undef, undef, $delay/1000);
+	return;
+}
diff --git a/dns-tank-st.pl b/dns-tank-st.pl
new file mode 100755
index 0000000..7327d74
--- /dev/null
+++ b/dns-tank-st.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings "all";
+
+use Net::DNS;
+
+my $max_sleep = 2000;         # max sleep between sequental lookups 2 seconds long
+my $max_burst_lookups = 15;   # max amount of lookup without delay
+
+my $domfile = 'domfile.txt';  # file format: domainname record_type number_of_values
+                              # num_of_values can be -1 if no A record exist
+
+sub lookup;     # hotpath :)
+sub nodomlist;
+sub usleep;     # millisecond sleep, 1000 milliseconds = 1 second
+
+nodomlist() unless ( -f $domfile );
+
+my @list;
+open (LIST, $domfile) or die ("Unable to read $domfile");
+
+while (<LIST>){
+	next if (($_ eq '') or ($_ =~ /^\s*#/));
+	chomp($_); chomp($_);
+	push @list, $_;
+}
+
+close LIST;
+
+my $res = Net::DNS::Resolver->new(
+	nameservers => [ '192.168.88.2' ],
+	recurse     => 1,
+	debug       => 0
+);
+
+my $lookup_cnt = int(rand($max_burst_lookups));
+while ( 1 ) {
+	my $ok = 0; my $error = 0;
+	for (my $i = 0; $i < 10000; $i++) {
+		if ($lookup_cnt <= 0){
+			usleep(int(rand($max_sleep)));
+			$lookup_cnt = int(rand($max_burst_lookups));
+		} else {
+			$lookup_cnt--;
+		}
+		my ($domain, $record_type, $amount) = split(/\s+/, $list[int(rand(@list))]);
+		my $result = lookup($domain, $record_type);
+
+		if (defined($result) and ($result == $amount)){ $ok++; }
+		elsif (($amount == -1) and ($result == undef)){ $ok++; }
+		else { $error++; }
+	}
+
+	print "Success/Error: $ok/$error\n";
+}
+
+exit 0;
+
+
+sub lookup {
+	my $host = shift;
+	my $type = shift;
+	my $rec_count = 0;
+	my $reply = $res->query($host, $type);
+
+	if (defined($reply)) {
+
+		foreach my $rr ($reply->answer) {
+			$rec_count++ if ($rr->type eq $type);
+		}
+
+		return $rec_count;
+	} else {
+#		warn "query failed: ", $res->errorstring, "\n";
+		return undef;
+	}
+}
+
+sub nodomlist {
+	print "Unable to find $domfile\n";
+	exit 1;
+}
+
+sub usleep {
+	my $delay = shift;
+	select(undef, undef, undef, $delay/1000);
+	return;
+}
diff --git a/dnszone-bind2unbound.json b/dnszone-bind2unbound.json
new file mode 100644
index 0000000..74dec5f
--- /dev/null
+++ b/dnszone-bind2unbound.json
@@ -0,0 +1,4 @@
+{
+"local" : "/home/eleksir/local.zone"
+}
+
diff --git a/dnszone-bind2unbound.pl b/dnszone-bind2unbound.pl
new file mode 100755
index 0000000..66d04a6
--- /dev/null
+++ b/dnszone-bind2unbound.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+
+use warnings "all";
+use strict;
+
+use JSON::PP;
+use DNS::ZoneParse;
+
+sub process_zone;
+
+my $conf_file = 'dnszone-bind2unbound.json';
+
+open (CONF, "$conf_file") || die "unable to read $conf_file";
+my $sep = $/; undef $/;
+my $conf = <CONF>;
+close CONF;
+$/ = $sep; undef $sep;
+
+$conf = decode_json $conf;
+my %CONF = %$conf;
+undef $conf;
+
+# теперь у нас есть хэш с названиями зон и путями до файлов
+foreach my $zone_name (keys(%CONF)){
+	process_zone($zone_name, $CONF{$zone_name});
+}
+
+exit 0;
+
+sub process_zone {
+	my ($name, $file) = @_;
+	my $zonefile = DNS::ZoneParse->new($file, $name);
+	my $zone = $zonefile->dump; # ref to hash
+	foreach my $record(@{${$zone}{NS}}){
+		print "$record->{name} $record->{ttl} $record->{class} NS $record->{host}\n";
+	}
+	foreach my $record(@{${$zone}{A}}){
+		print "$record->{name} $record->{ttl} $record->{class} A $record->{host}\n";
+	}
+        foreach my $record(@{${$zone}{AAAA}}){
+		print "$record->{name} $record->{ttl} $record->{class} AAAA $record->{host}\n";
+	}
+        foreach my $record(@{${$zone}{CNAME}}){
+		print "$record->{name} $record->{ttl} $record->{class} CNAME $record->{host}\n";
+	}
+}
diff --git a/i3status-mt-json b/i3status-mt-json
new file mode 100755
index 0000000..b2e5d3f
--- /dev/null
+++ b/i3status-mt-json
@@ -0,0 +1,291 @@
+#!/usr/bin/perl
+# vim: set ai et ts=8 sw=8 sts=8 ft=perl :
+
+# set username
+# set uptime
+# set time
+# set xtitle of focused window
+# set list of windows for current tag
+# set list of windows for all tags
+# set la
+# set current language
+# set battery charge
+
+# main loop impl. :
+# save cur. str and compare it with prev. if it differs - update
+
+# proposed: 3 types of loop:
+# slow loop for batt charge, la
+# 1 second loop for time, uptime
+# main (fast) loop for window name, language
+
+use Fcntl;
+use threads;
+use threads::shared;
+
+sub gettimestr();
+sub getfocusedwidowtitlestr();
+sub getlangstr();
+sub getuptimestr();
+sub getlastr();
+sub getbatterychargestr1();
+sub getbatterychargestr2();
+sub getinboxstat();
+sub getproblemsstat();
+
+sub slow_thread();
+sub onesec_thread();
+
+my $pstr = '';
+
+my $charge :shared;
+my $la :shared;
+my $uptime :shared;
+my $time :shared;
+my $inbox :shared;
+my $problems :shared;
+
+my $default_color = '#3e78fd';
+
+threads->create('slow_thread');
+threads->create('onesec_thread');
+
+sleep 1;
+
+syswrite STDOUT, "{\"version\":1, \"click_events\": true}\n";
+syswrite STDOUT, "[\n[],\n";
+while(1){
+	$str = "[ ";
+#	$str .= getfocusedwidowtitlestr() . ",";
+	$str .= getfocusedwidowtitlestr() . ", ";
+	$str .= sprintf("{ \"name\" : \"username\", \"full_text\" : \"%s\", \"color\" : \"%s\" }", $ENV{'USER'}, $default_color) . ", ";
+	$str .= getlangstr() . ", ";
+	$str .= $uptime . ", ";
+	$str .= $la . ", ";
+	$str .= $charge . ", ";
+	$str .= $time;
+	$str .= " ],\n";
+	if($pstr ne $str){
+		syswrite STDOUT, "$str\n";
+		$pstr = $str;
+	}
+
+# sleep for 0.333 second;
+	select(undef, undef, undef, 0.333);
+}
+
+sub slow_thread(){
+	threads->detach();
+
+	while(1){
+		$charge = getbatterychargestr2();
+		$la = getlastr();
+		sleep 300;
+	}
+}
+
+sub onesec_thread(){
+	threads->detach();
+
+	while(1){
+		$uptime = getuptimestr();
+		$time = gettimestr();
+		$inbox = getinboxstat();
+		$problems = getproblemsstat();
+# as we report time with precision of 1 minute, update 1/60 seconds
+		sleep 60;
+	}
+
+}
+
+
+sub gettimestr(){
+	my ($sec, $min, $hour, $mday, $mon, $year, $wday) = (localtime)[0,1,2,3,4,5,6];
+	my @months = ('Янв', 'Фев', 'Мар', 'Апр', 'Май', 'Июн', 'Июл', 'Авг', 'Сен', 'Окт', 'Ноя', 'Дек');
+	my @wdays = ('Вс', 'Пн', 'Вт', 'Ср', 'Чт', 'Пт', 'Сб');
+	$year = $year + 1900;
+
+	my $str .= sprintf("{ \"name\" : \"time\", \"full_text\" : \"%s, %s %s %s  %02s:%02s\", \"color\" : \"%s\" }", $wdays[$wday], $mday, $months[$mon], $year, $hour, $min, $default_color);
+
+	undef $sec; undef $min; undef $hour; undef $mday; undef $mon; undef $year; undef $wday;
+	@months = -1; undef @months;
+	@wdays = -1; undef @wdays;
+
+	return $str;
+}
+
+sub getfocusedwidowtitlestr(){
+	my $str;
+
+	if (-x '/usr/bin/xdotool'){
+		$str = `xdotool getactivewindow getwindowname`;
+	}elsif (-x '/usr/bin/xprop'){
+		$str = (split( /=/, `xprop -id \$(xprop -root _NET_ACTIVE_WINDOW | cut -d ' ' -f 5) _NET_WM_NAME`))[1];
+		chop $str; chop $str; $str = reverse $str; chop $str; chop $str; $str = reverse $str;
+	}
+
+	chomp($str);
+	$string =~ s/[\"|\{|\}|\'|,]/_/g;
+
+	if (length($string) > 64){
+		$string = substr($string, 0, 64);
+	}
+
+	$str = sprintf ("{ \"name\" : \"title\", \"full_text\" : \"%s\", \"color\" : \"%s\" }", $str, $default_color);
+
+	return $str;
+}
+
+sub getuptimestr(){
+	if(tell(UPTIME) == -1){ open UPTIME, "/proc/uptime"; };
+
+	$u = <UPTIME>;
+	seek UPTIME, SEEK_SET, 0;
+	$u = (split(/ /, $u, 2))[0];
+	$days = int($u / 86400); # 86400 = 1 day
+	$hours = int(($u - (86400 * $days)) / 3600); # 3600 = 1 hour
+	$minutes = int(($u - (86400 * $days) - (3600 * $hours)) / 60);
+	$seconds = int($u - (86400 * $days) - (3600 * $hours) - (60 * $minutes));
+	my $str = sprintf("{ \"name\" : \"uptime\", \"full_text\" : \"UP: %sd,%02sh,%02sm\", \"color\" : \"%s\" }", $days, $hours, $minutes, $default_color);
+
+	undef $u; undef $days; undef $hours; undef $minutes; undef $seconds;
+
+	return $str;
+}
+
+sub getlastr(){
+	if(tell(LA) == -1){ open LA, "/proc/loadavg"; };
+
+	my $la = <LA>;
+	seek LA, SEEK_SET, 0;
+	$la = (split(/ /, $la, 2))[0];
+	$la = sprintf("{ \"name\" : \"la\", \"full_text\" : \"LA: %s\", \"color\" : \"%s\" }", $la, $default_color);
+
+	return $la;
+}
+
+sub getbatterychargestr1(){
+	my $str = '';
+
+	if (-f "/sys/class/power_supply/BAT0/present"){
+		open A, "/sys/class/power_supply/BAT0/present";
+		$P = <A>;
+		close A;
+		chomp($P);
+
+		if($P eq '1'){
+			open A, "/sys/class/power_supply/BAT0/energy_full";
+			my $full_charge = <A>; chomp($full_charge); close A;
+			open A, "/sys/class/power_supply/BAT0/energy_now";
+			my $current_charge = <A>; chomp($current_charge); close A;
+			$str .= sprintf("Bat:%03d%%", int(($current_charge / $full_charge) * 100) );
+			undef $current_charge; undef $full_charge;
+		}
+	}
+
+	$str = sprintf("{ \"name\" : \"powersource\", \"full_text\" : \"%s\", \"color\" : \"#555555\" }", $str);
+
+	return $str;
+}
+
+sub getbatterychargestr2(){
+	my $str = '';
+	my $color = $default_color;
+	open AC,"/sys/class/power_supply/ADP1/online";
+
+	if(<AC> == 1){
+		$str .= "AC";
+	}else{
+		$str .= "DC";
+	}
+
+	close AC; # display % charge only if possible
+	if (open DC,"/sys/class/power_supply/BAT0/capacity"){
+		my $charge = <DC>;
+		close DC;
+		chomp($charge);
+
+		if ($charge < 10){
+			$color = '#800000';
+		} elsif (($charge >= 10) and ($charge < 25)){
+			$color = '#ffa500';
+		} elsif (($charge >= 25) and ($charge < 80)){
+			$color = '#008000';
+		} else {
+			$color = '#0000a0';
+		}
+
+		$str .= " $charge";
+	}
+
+	$str = sprintf("{ \"name\" : \"powersource\", \"full_text\" : \"Power: %s%%\", \"color\" : \"%s\" }", $str, $color);
+
+	return $str;
+}
+
+sub getlangstr(){
+	my $str .= "Lang: ";
+
+	if(`xset -q` =~ /Group 2:     on /o){
+		$str .= "RU";
+	}else{
+		$str .= "EN";
+	}
+
+	$str = sprintf("{ \"name\":\"lang\", \"full_text\" : \"%s\", \"color\" : \"%s\" }", $str, $default_color);
+
+	return $str;
+}
+
+sub getinboxstat(){
+	if((-d "$ENV{'HOME'}/Maildir/INBOX/cur") and (-d "$ENV{'HOME'}/Maildir/INBOX/new")){
+		my $inboxtotal = 0;
+		my $inboxunread = 0;
+		my $inboxunseen = 0;
+		opendir DIR, "$ENV{'HOME'}/Maildir/INBOX/cur";
+		foreach (readdir(DIR)){
+			next if ($_ eq '.');
+			next if ($_ eq '..');
+			unless ($_ =~ /,F?R?S$/){ $inboxunread++; }
+			$inboxtotal++;
+		}
+		closedir DIR;
+		opendir DIR, "$ENV{'HOME'}/Maildir/INBOX/new";
+		foreach (readdir(DIR)){
+			next if ($_ eq '.');
+			next if ($_ eq '..');
+			unless ($_ =~ /,F?R?S$/){ $inboxunread++; $inboxunseen++; }
+			$inboxtotal++;
+		}
+		closedir DIR;
+		return (sprintf("i %d/%d/%d", $inboxunseen, $inboxunread, $inboxtotal));
+	}
+	return('');
+}
+
+sub getproblemsstat(){
+	if((-d "$ENV{'HOME'}/Maildir/Problems/cur") and (-d "$ENV{'HOME'}/Maildir/Problems/new")){
+		my $inboxtotal = 0;
+		my $inboxunread = 0;
+		my $inboxunseen = 0;
+		opendir DIR, "$ENV{'HOME'}/Maildir/Problems/cur";
+		foreach (readdir(DIR)){
+			next if ($_ eq '.');
+			next if ($_ eq '..');
+			unless ($_ =~ /,F?R?S$/){ $inboxunread++; }
+			$inboxtotal++;
+		}
+		closedir DIR;
+		opendir DIR, "$ENV{'HOME'}/Maildir/Problems/new";
+		foreach (readdir(DIR)){
+			next if ($_ eq '.');
+			next if ($_ eq '..');
+			unless ($_ =~ /,F?R?S$/){ $inboxunread++; $inboxunseen++; }
+			$inboxtotal++;
+		}
+		closedir DIR;
+		return (sprintf("p %d/%d/%d", $inboxunseen, $inboxunread, $inboxtotal));
+	}
+	return('');
+}
+
diff --git a/munincurrency b/munincurrency
new file mode 100644
index 0000000..2d9e704
--- /dev/null
+++ b/munincurrency
@@ -0,0 +1,140 @@
+#!/usr/bin/perl
+use warnings "all";
+use strict;
+use POSIX qw(strftime);
+
+# берём курс валют с сайта ЦБ РФ
+my $data = `curl -s http://www.cbr.ru/scripts/RssCurrency.asp | iconv -f cp1251 -t utf8`;
+
+$data = (split(/\[CDATA\[ /, $data))[1];
+$data = (split(/\]\]/, $data))[0];
+my @data = split(/<br> /, $data);
+$data = undef;
+
+my ($usd, $eu, $gbp, $swf, $jy, $chy);
+foreach (@data){
+	if ($_ =~ /^Швейцарский франк/) { $swf = (split(/ \- /, $_))[1]; $swf =~ s/\,/\./; }
+	if ($_ =~ /^Фунт стерлингов Соединенного королевства/) { $gbp = (split(/ \- /, $_))[1]; $gbp =~ s/\,/\./; }
+	if ($_ =~ /^Доллар США/) { $usd = (split(/ \- /, $_))[1]; $usd =~ s/\,/\./; }
+	if ($_ =~ /^Евро/) { $eu = (split(/ \- /, $_))[1]; $eu =~ s/\,/\./; }
+	if ($_ =~ /^Японская иена/){ $jy = (split(/ \- /, $_))[1]; $jy =~ s/\,/\./; $jy =~ s/<br>//;}
+	if ($_ =~ /^Китайский юань/) { $chy = (split(/ \- /, $_))[1]; $chy =~ s/\,/\./; }
+}
+
+# Берём цену бочки нефти с портала mfd.ru
+my $date = strftime "%d.%m.%Y", localtime;
+my $oil = `curl -s -q 'http://mfd.ru/export/handler.ashx/_Brent_Crude_Oil_15min_09122015_09122015.txt?TickerGroup=2&Tickers=1*&Alias=false&Period=4&timeframeValue=1&timeframeDatePart=day&StartDate=$date&EndDate=$date&SaveFormat=0&SaveMode=0&FileName=_Brent_Crude_Oil_15min_09122015_09122015.txt&FieldSeparator=%253b&DecimalSeparator=.&DateFormat=yyyyMMdd&TimeFormat=HHmmss&DateFormatCustom=&TimeFormatCustom=&AddHeader=true&RecordFormat=2&Fill=true'`;
+my @a = split(/\n/, $oil);
+$oil = $a[@a - 1];
+$oil = (split(/;/, $oil))[4];
+
+# берём цену бакса и еврика у альфабанка
+$data = `curl -q -s https://alfabank.ru/_/rss/_currency.html|iconv -f cp1251 -t utf8`;
+my ($alfadollarbuy, $alfadollarsell, $alfaeurobuy, $alfaeurosell);
+if ($data =~ /<td id="Доллар СШАcashBy">(\d+\,?\d*)<\/td>/){
+	$alfadollarbuy = $1;
+	$alfadollarbuy =~ s/,/\./;
+}
+if ($data =~ /<td id="Доллар СШАcashSell">(\d+\,?\d*)<\/td>/){
+	$alfadollarsell = $1;
+	$alfadollarsell =~ s/,/\./;
+}
+
+if ($data =~ /<td id="ЕвроcashBy">(\d+\,?\d*)<\/td>/){
+	$alfaeurobuy = $1;
+	$alfaeurobuy =~ s/,/\./;
+}
+if ($data =~ /<td id="ЕвроcashSell">(\d+\,?\d*)<\/td>/){
+	$alfaeurosell = $1;
+	$alfaeurosell =~ s/,/\./;
+}
+
+# берём цену бакса и еврика у банка москвы
+$data = `curl -s -q http://www.bm.ru/ru/personal/services/exchange/`;
+my($bmdollarbuy, $bmdollarsell, $bmeurobuy, $bmeurosell);
+if($data =~ /Доллар США\s+<\/td>\s+<td>\s+(\d\d\,\d\d)\s+<\/td>\s+<td>\s+(\d\d\,\d\d)\s+<\/td>/){
+	$bmdollarsell = $2;
+	$bmdollarbuy = $1;
+	$bmdollarsell =~ s/,/\./;
+	$bmdollarbuy =~ s/,/\./;
+}
+if($data =~ /ЕВРО\s+<\/td>\s+<td>\s+(\d\d\,\d\d)\s+<\/td>\s+<td>\s+(\d\d\,\d\d)\s+<\/td>/){
+	$bmeurosell = $2;
+	$bmeurobuy = $1;
+	$bmeurosell =~ s/,/\./;
+	$bmeurobuy =~ s/,/\./;
+}
+
+# берём цену бакса и еврика у райффазена
+$data = `curl -s -q http://www.raiffeisen.ru/currency_rates/`;
+my ($raifdollarbuy, $raifdollarsell, $raifeurobuy, $raifeurosell);
+if($data =~ /"USD":{"UNITS":1,"RUR_BUY":"(\d+\.\d+)","RUR_SALE":"(\d+\.\d+)","USD_BUY":.+,"USD_SALE":1}/){
+	$raifdollarbuy = $1;
+	$raifdollarsell = $2;
+}
+if($data =~ /"EUR":{"UNITS":1,"RUR_BUY":"(\d+\.\d+)","RUR_SALE":"(\d+\.\d+)","USD_BUY":.+,"USD_SALE":.+}/){
+	$raifeurobuy = $1;
+	$raifeurosell = $2;
+}
+
+# берём цену бакса и еврика у сбера
+$data = `curl -s -q http://data.sberbank.ru/moscow/ru/quotes/currencies/?base=beta|iconv -f cp1251 -t utf8`;
+my $sberdollarbuy = (split(/\s+</, (split (/<td style="vertical\-align:middle;font\-size:16px;color:#[a-f|0-9]+">\s*/, $data))[1]))[0];
+$sberdollarbu =~ s/,/\./;
+my $sberdollarsell = (split(/\s+</, (split (/<td style="vertical\-align:middle;font\-size:16px;color:#[a-f|0-9]+">\s*/, $data))[2]))[0];
+$sberdollarsel =~ s/,/\./;
+my $sbereurobuy = (split(/\s+/, (split (/<td style="vertical\-align:middle;font\-size:16px;color:#[a-f|0-9]+">\s*/, $data))[3]))[0];
+$sbereurobuy =~ s/,/\./;
+my $sbereurosell = (split(/\s+/, (split (/<td style="vertical\-align:middle;font\-size:16px;color:#[a-f|0-9]+">\s*/, $data))[4]))[0];
+$sbereurosel =~ s/,/\./;
+
+# берём цену бакса и еврика у втб24
+$data = `curl -s -q 'http://www.vtb24.ru/_vti_bin/Vtb24.Internet/CurrencyRateWebService.svc/GetCurrencyRatesJson?filter=8'`;
+my ($vtbdollarbuy, $vtbdollarsell, $vtbeurobuy, $vtbeurosell);
+if($data =~ /Buy.:.(\d+\,\d+).+USD.+Sell.:.(\d+\,\d+).+Title.:.Доллар США./){
+	$vtbdollarbuy =  $1;
+	$vtbdollarsell = $2;
+	$vtbdollarbuy =~ s/,/\./;
+	$vtbdollarsell =~ s/,/\./;
+}
+if($data =~ /Buy.:.(\d+\,\d+).+EUR.+"Sell":"(\d*\,\d+)"\,.+"Title":"Евро"/){
+	$vtbeurobuy = $1;
+	$vtbeurosell = $2;
+	$vtbeurobuy =~ s/,/\./;
+	$vtbeurosell =~ s/,/\./;
+}
+
+
+open (DATA, ">/var/cache/munin/currency.txt");
+print DATA <<TEXT;
+usd:$usd
+eu:$eu
+gbp:$gbp
+swf:$swf
+jy:$jy
+chy:$chy
+oil:$oil
+alfadollarbuy:$alfadollarbuy
+alfadollarsell:$alfadollarsell
+alfaeurobuy:$alfaeurobuy
+alfaeurosell:$alfaeurosell
+bmdollarbuy:$bmdollarbuy
+bmdollarsell:$bmdollarsell
+bmeurobuy:$bmeurobuy
+bmeurosell:$bmeurosell
+raifdollarbuy:$raifdollarbuy
+raifdollarsell:$raifdollarsell
+raifeurobuy:$raifeurobuy
+raifeurosell:$raifeurosell
+sberdollarbuy:$sberdollarbuy
+sberdollarsell:$sberdollarsell
+sbereurobuy:$sbereurobuy
+sbereurosell:$sbereurosell
+vtbdollarbuy:$vtbdollarbuy
+vtbdollarsell:$vtbdollarsell
+vtbeurobuy:$vtbeurobuy
+vtbeurosell:$vtbeurosell
+TEXT
+
+exit 0;
+
diff --git a/muninweather b/muninweather
new file mode 100644
index 0000000..a07c6e8
--- /dev/null
+++ b/muninweather
@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings "all";
+
+use bytes;
+use XML::Simple;
+
+#use Data::Dumper;
+
+use POSIX qw(strftime);
+use Fcntl;
+
+my $tmpdir = '/tmp';
+my $citiesfile = "$tmpdir/cities.xml";
+my $outfile = "$tmpdir/munin_weather.txt";
+
+my $date = strftime "%Y-%m-%d", localtime;
+
+sub parsedata($); # give $filename, returns [pressure, humidity, temperature, geomag index]
+sub getIdByCountryAndCity(@);
+
+# get yandex data with city<->id stuff
+unless(-f $citiesfile){
+	`curl -s -q -k --no-buffer --retry 3 --retry-delay 1 --connect-timeout 15 --tcp-nodelay 'https://pogoda.yandex.ru/static/cities.xml' >$citiesfile`;
+	unless($? == 0){
+		print "unable to download https://pogoda.yandex.ru/static/cities.xml";
+		unlink($citiesfile);
+		exit 1;
+	}
+}
+
+my %city;
+$city{'msk'} = getIdByCountryAndCity('Россия', 'Москва');
+$city{'spb'} = getIdByCountryAndCity('Россия', 'Санкт-Петербург');
+$city{'nsk'} = getIdByCountryAndCity('Россия', 'Новосибирск');
+$city{'ksk'} = getIdByCountryAndCity('Россия', 'Красноярск');
+$city{'nnov'} = getIdByCountryAndCity('Россия', 'Нижний Новгород');
+$city{'vld'} = getIdByCountryAndCity('Россия', 'Владивосток');
+$city{'vlg'} = getIdByCountryAndCity('Россия', 'Волгоград');
+$city{'ast'} = getIdByCountryAndCity('Казахстан', 'Астана');
+
+my $str = '';
+foreach my $c (keys(%city)){
+	my $id = $city{$c};
+	my $xmldata = '';
+	unless(-f "$tmpdir/$id.xml"){
+		for(1..9){
+			$xmldata .= `curl -s -k --no-buffer --connect-timeout 20 --tcp-nodelay https://export.yandex.ru/weather-ng/forecasts/$id.xml`;
+			if($? == 0){
+				sysopen(XMLDATA, "$tmpdir/$id.xml", O_WRONLY|O_CREAT|O_TRUNC)||die("Unable to write to $tmpdir/$id.xml");
+				syswrite XMLDATA, $xmldata;
+				close XMLDATA;
+				last;
+			}
+			sleep 1;
+		}
+	}
+	my @array = @{parsedata("$tmpdir/$id.xml")};
+	$str .= sprintf( "%stemp:%s
+%spres:%s
+%shum:%s
+%smag:%s
+", $c, $array[2],
+   $c, $array[0],
+   $c, $array[1],
+   $c, $array[3] );
+}
+
+sysopen(RESULT, $outfile, O_WRONLY|O_CREAT|O_TRUNC)||die("Unable to write to $outfile");
+syswrite RESULT, $str;
+close RESULT;
+
+exit 0;
+
+sub getIdByCountryAndCity(@){
+        my ($country, $city) = @_;
+        my $id = undef;
+        my $simple = XML::Simple->new( KeyAttr => '' );
+        my $ref = eval(sprintf("\$simple->XMLin('%s')", $citiesfile));
+        foreach (@{$ref->{country}}){
+                my %hash = %$_;
+                my $a = sprintf("%s", $hash{'name'});
+                next unless ($a eq $country);
+                foreach(@{$hash{'city'}}){
+                        next unless(${$_}{'content'} eq $city);
+                        $id = ${$_}{'id'};
+                        last;
+                }
+        }
+        return $id;
+}
+
+
+sub parsedata($){
+	my $file = shift ;
+	my @a;
+	my $simple = XML::Simple->new(KeyAttr => '');
+# WTF?!!!
+	my $data = eval(sprintf("\$simple->XMLin('%s')\n", $file));
+# okay, parse stuff
+	$a[0] = $data->{fact}->{pressure}->{content};
+	$a[1] = $data->{fact}->{humidity};
+	$a[2] = $data->{fact}->{temperature}->{content};
+	foreach (@{$data->{day}}){
+		my $ref = $_;
+		if (defined($ref->{biomet}) and ($ref->{date} eq $date)){
+			$a[3] = $ref->{biomet}{geomag};
+			last;
+		}
+	}
+	unless(defined($a[3])){
+		my $newdate = strftime('%Y-%m-%d', localtime(time + 86400));
+		foreach (@{$data->{day}}){
+			my $ref = $_;
+			if (defined($ref->{biomet}) and ($ref->{date} eq $newdate)){
+				$a[3] = $ref->{biomet}{geomag};
+				last;
+			}
+		}
+	}
+	unlink($file);
+	return \@a;
+}
diff --git a/p.pl b/p.pl
new file mode 100755
index 0000000..61b0538
--- /dev/null
+++ b/p.pl
@@ -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>&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__
+
diff --git a/paste.pl b/paste.pl
new file mode 100755
index 0000000..b400bed
--- /dev/null
+++ b/paste.pl
@@ -0,0 +1,292 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings "all";
+use Fcntl;
+
+my $str = '';
+
+my $DIR = '/tmp/paste';
+my $fsize = 262144;
+
+# assume GET request
+if (defined($ARGV[0])){
+	if ($ARGV[0] eq 'e'){
+		$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;
+	}
+	if ($ARGV[0] eq 'd'){
+		$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;
+	}
+	if (-f "$DIR/$ARGV[0]") {
+		$str .= 'Status: 200 OK
+Pragma: no-cache
+Cache-Control: no-cache
+Content-Language: en, ru
+Content-Type: text/plain; charset=UTF-8
+
+';
+
+		open DATA, "$DIR/$ARGV[0]";
+		while(<DATA>){
+			$str .= $_;
+		}
+		close DATA;
+	}else{
+		$str .= "Status: 404 Not Found
+Pragma: no-cache
+Cache-Control: no-cache
+Content-Language: en, ru
+Content-type: text/plain
+
+http://p.dafuq.ru/$ARGV[0] Not found.
+";
+	}
+
+# assume POST(?) request
+}else{
+	if ((defined($ENV{'CONTENT_LENGTH'})) and $ENV{'CONTENT_LENGTH'} < $fsize){
+		my $host;
+
+		if ((defined $ENV{'HTTP_HOST'})){
+			$host = $ENV{'HTTP_HOST'};
+		} elsif (defined ($ENV{'SERVER_NAME'})){
+			$host = $ENV{'SERVER_NAME'};
+		} else {
+# ??? No required environment variables, this script intended to run under proper http/cgi
+			$str = 'Status: 400 Bad Request
+Pragma: no-cache
+Cache-Control: no-cache
+Content-Language: en, ru
+Content-type: text/plain
+
+';
+		}
+
+		my $fname;
+
+		for(my $i = 0;$i < 3; $i++){
+			$fname .= ('a'..'z', 'A'..'Z')[int rand length(join('',('a'..'z', 'A'..'Z')))];
+		}
+
+		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
+
+';
+		}
+
+		sysopen(DATA, "$DIR/$fname", O_WRONLY|O_CREAT|O_TRUNC);
+		syswrite DATA, $paste;
+		close(DATA);
+
+		$str = "Pragma: no-cache
+Cache-Control: no-cache
+Content-Language: en, ru
+Content-type: text/plain
+
+http://$host/$fname
+";
+
+	}else{
+		$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>
+	<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;
+
+__END__
diff --git a/paste2.pl b/paste2.pl
new file mode 100755
index 0000000..fedee85
--- /dev/null
+++ b/paste2.pl
@@ -0,0 +1,381 @@
+#!/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__
+
diff --git a/rle.pl b/rle.pl
new file mode 100644
index 0000000..02a6770
--- /dev/null
+++ b/rle.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings "all";
+use Fcntl;
+
+my $fname = undef;
+
+if(defined($ARGV[0])){
+	if($ARGV[0] eq "--help"){
+		syswrite STDOUT, "Usage: $0 <filename>\n";
+		syswrite STDOUT, "or pipe data thrugh $0's STDIN to $0 STDOUT\n";
+		exit 0;
+	}
+	$fname = $ARGV[0];
+}
+
+my $byte;
+my $counter = 1;
+my $block_size = 65536;
+my $first_remembered_byte = undef;
+my $second_remembered_byte = undef;
+
+if (defined($fname)){
+	sysopen(STDIN, $fname, O_RDONLY) or die "Can not open file $fname!\n";
+	sysopen(STDOUT, "$fname.rle", O_WRONLY|O_TRUNC|O_CREAT) or die "Can not open file $fname.rle!\n";
+}
+binmode(STDIN);
+binmode(STDOUT);
+
+exit 0 if ((sysread(STDIN, $byte, 1)) == 0);
+
+$first_remembered_byte = $byte;
+my $output_buf_byte_counter = 0;
+my $output_buf = '';
+my $input_buf = '';
+
+while ( 1 ) {
+	my $read_bytes = sysread(STDIN, $input_buf, $block_size);
+	last if($read_bytes == 0);
+	my $i = 0;
+	for ( $i = 0; $i < $read_bytes; $i++ ) {
+		$byte = substr( $input_buf, $i, 1);
+		last unless(defined($byte));
+		$second_remembered_byte = $first_remembered_byte;
+		$first_remembered_byte = $byte;
+
+		if(($first_remembered_byte eq $second_remembered_byte) and ($counter <= 254)){
+			$counter++;
+			next;
+		}
+
+		if ($output_buf_byte_counter == $block_size){
+			syswrite STDOUT, $output_buf || die "Cannot write output stream!\n";
+			$output_buf = '';
+			$output_buf_byte_counter = 0;
+		}else{
+			$output_buf_byte_counter++;
+		}
+
+		$output_buf .= chr($counter) . $second_remembered_byte;
+		$second_remembered_byte = $first_remembered_byte;
+		$counter = 1;
+	}
+	undef $i;
+	undef $read_bytes;
+}
+close(STDIN);
+# 0-byte string
+exit 0 unless (defined($first_remembered_byte));
+# 1-byte string
+unless(defined($second_remembered_byte)){
+	$output_buf =  chr($counter) . $first_remembered_byte;
+}else{
+# 2+ bytes string
+	$output_buf .= chr($counter) . $second_remembered_byte;
+}
+syswrite STDOUT, $output_buf || die "Cannot write output stream!\n";
+close(STDOUT);
+undef $fname;
+undef $counter;
+undef $first_remembered_byte;
+undef $second_remembered_byte;
+undef $byte;
+undef $input_buf;
+undef $output_buf;
diff --git a/shorten.old.pl b/shorten.old.pl
new file mode 100755
index 0000000..bd9d2cd
--- /dev/null
+++ b/shorten.old.pl
@@ -0,0 +1,195 @@
+#!/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>
diff --git a/shorten.pl b/shorten.pl
new file mode 100755
index 0000000..e7e56f6
--- /dev/null
+++ b/shorten.pl
@@ -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>
diff --git a/shorten2.pl b/shorten2.pl
new file mode 100755
index 0000000..e7e56f6
--- /dev/null
+++ b/shorten2.pl
@@ -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>
diff --git a/unrle.pl b/unrle.pl
new file mode 100644
index 0000000..cbe7d1f
--- /dev/null
+++ b/unrle.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings "all";
+use Fcntl;
+
+my $fname = undef;
+if(defined($ARGV[0])){
+	if($ARGV[0] eq "--help"){
+		syswrite STDOUT, "Usage: $0 <filename>\n";
+		syswrite STDOUT, "or pipe data thrugh $0's STDIN to $0 STDOUT\n";
+		exit 0;
+	}
+	exit unless ($ARGV[0] =~ /\.rle$/);
+	$fname = $ARGV[0];
+	$fname = substr($fname, 0, -4);
+}
+
+my $byte = '';
+my $dbyte = '';
+my $block_size = 65536;
+
+if (defined($fname)){
+	sysopen(STDIN, "$fname.rle", O_RDONLY) or die "Can not open file $fname!\n";
+	sysopen(STDOUT, $fname, O_WRONLY|O_TRUNC|O_CREAT) or die "Can not open file $fname.rle!\n";
+}
+binmode(STDIN);
+binmode(STDOUT);
+
+my $output_buf_byte_counter = 0;
+my $output_buf = '';
+my $input_buf ='';
+
+while ( 1 ) {
+	my $read_bytes = sysread(STDIN, $input_buf, $block_size);
+	last unless(defined($read_bytes));
+	last if($read_bytes == 0);
+	my $i = 0;
+	for ( $i = 0; $i < $read_bytes; $i++ ) {
+		$dbyte = substr( $input_buf, $i, 1);
+		last unless(defined($dbyte));
+		$i++;
+		$byte = substr( $input_buf, $i, 1);
+		last unless(defined($byte));
+
+		for(my $i = 0; $i < ord($dbyte); $i++){
+			if ($output_buf_byte_counter == $block_size){
+				syswrite STDOUT, $output_buf || die "Cannot write output stream!\n";
+				$output_buf = '';
+				$output_buf_byte_counter = 0;
+			}else{
+				$output_buf_byte_counter++;
+			}
+			$output_buf .= $byte;
+		}
+	}
+	undef $i;
+	undef $read_bytes;
+}
+close(STDIN);
+syswrite STDOUT, $output_buf || die "Cannot write output stream!\n";
+close(STDOUT);
+undef $fname;
+undef $byte;
+undef $dbyte;
+undef $block_size;
+undef $output_buf_byte_counter;
+undef $output_buf;
+undef $input_buf;
diff --git a/wp.pl b/wp.pl
new file mode 100755
index 0000000..bcc89f1
--- /dev/null
+++ b/wp.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+#
+use strict;
+use warnings "all";
+
+use DBD::mysql;
+
+my $dsn = 'DBI:mysql:wordpress:localhost';
+my $db_user_name = 'root';
+my $db_password = '';
+my ($id, $password);
+my $dbh = DBI->connect($dsn, $db_user_name, $db_password);
+$dbh->{'mysql_enable_utf8'} = 1;
+$dbh->do('set names utf8');
+
+my $sth = $dbh->prepare(qq{
+SELECT ID, post_date, post_content, post_title FROM wp_posts
+    });
+$sth->execute();
+
+my $PWD = $ENV{'PWD'};
+my @posts;
+my %POSTS;
+while (my ($id, $post_date, $post_content, $post_title) = $sth->fetchrow_array())
+{
+	push @posts, $id;
+	chdir($PWD);
+	unless(-d "wordpress")
+	{
+		mkdir "wordpress";
+	}
+	unless(-d "wordpress/$id")
+	{
+		mkdir "wordpress/$id";
+	}
+	chdir("wordpress/$id");
+	open(POST, ">post_content");
+	print POST "$post_content";
+	close POST;
+	open(TITLE, ">post_title");
+	print TITLE "$post_title";
+	close TITLE;
+	open(DATE, ">post_date");
+	print DATE "$post_date";
+	close DATE;
+	$POSTS{$id} = <<DATA;
+Date: $post_date
+Title: $post_title
+Status: public
+
+$post_content
+DATA
+
+}
+
+$sth->finish();
+foreach my $post (@posts){
+	print "POST: $post\n";
+	$sth = $dbh->prepare(qq{
+		SELECT `term_taxonomy_id` FROM `wp_term_relationships` WHERE `object_id`=$post;
+	});
+	$sth->execute();
+	my @tags;
+	while(my ($tag) = $sth->fetchrow_array()){
+		push @tags, $tag;
+	}
+	$sth->finish();
+	print "TAGS: ";
+       	print join(',', @tags);
+	print "\n";
+
+	$sth = $dbh->prepare(qq{
+		 select name from `wp_terms` where `term_id` in (SELECT `term_taxonomy_id` FROM `wp_term_relationships` WHERE `object_id`=$post);
+	});
+	$sth->execute();
+	my @categories;
+	while(my ($category) = $sth->fetchrow_array()){
+		next if($category eq 'Uncategorized');
+		push @categories, $category;
+	}
+	$sth->finish();
+	my $cat = '';
+	my $category;
+	foreach $category (@categories){
+		$cat .= $category . ', ';
+	}
+	chop($cat);chop($cat);
+	chdir($PWD);
+	chdir("wordpress/$post");
+	open(CAT, ">post_tags");
+	print CAT $cat;
+	close CAT;
+	open(P, ">/$post.md");
+	print P "Tags: $cat
+$POSTS{$post}";
+}
+__END__
+
+query list of categories for post id
+select name from `wp_terms` where `term_id` in (SELECT `term_taxonomy_id` FROM `wp_term_relationships` WHERE `object_id`=501);
+
diff --git a/yagecibycocin.pl b/yagecibycocin.pl
new file mode 100755
index 0000000..6b7cd37
--- /dev/null
+++ b/yagecibycocin.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings "all";
+
+use XML::Simple;
+use bytes;
+
+my $PROGRAM_NAME = $0;
+
+my $xml = `curl -s -q 'https://pogoda.yandex.ru/static/cities.xml' >/tmp/cities.xml`;
+if ($? != 0){
+	print "Network error, quitting.";
+	exit 1;
+}
+
+sub getIdByCountryAndCity(@); # supply Country and City in RUSSIAN NOTATION !
+sub usage();
+
+usage() unless (defined ($ARGV[0]) and ($ARGV[0] ne ''));
+usage() unless (defined ($ARGV[1]) and ($ARGV[1] ne ''));
+
+my $id = getIdByCountryAndCity($ARGV[0], $ARGV[1]);
+if (defined($id)){
+	printf("%s\n", $id);
+}else{
+	print "Error - no such id @ yandex weather xml data list\n";
+	exit 1;
+}
+exit 0;
+
+sub getIdByCountryAndCity(@){
+	my ($country, $city) = @_;
+	my $id = undef;
+	my $simple = XML::Simple->new( KeyAttr => '' );
+	my $ref = $simple->XMLin('/tmp/cities.xml');
+	foreach (@{$ref->{country}}){
+		my %hash = %$_;
+		my $a = sprintf("%s", $hash{'name'});
+		next unless ($a eq $country);
+		foreach(@{$hash{'city'}}){
+			next unless(${$_}{'content'} eq $city);
+			$id = ${$_}{'id'};
+                        last;
+		}
+	}
+	return $id;
+}
+
+sub usage(){
+	print <<EOF;
+yagecibycocin
+Get yandex city id by country name and city name. 
+usage: $PROGRAM_NAME Country City
+  if country name or city consists of multiple words, it must be enclosed with quotation
+       $PROGRAM_NAME \"Country Name\" \"City Name\"
+
+Script understands country name and city name exactly as they appear at
+http://weather.yandex.ru/static/cities.xml
+EOF
+	exit 0;
+}
diff --git a/zip_fb2.pl b/zip_fb2.pl
new file mode 100755
index 0000000..06f06cb
--- /dev/null
+++ b/zip_fb2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+#
+# this script conpress all *.fb2 files in current directory with zip
+#
+
+use strict;
+use warnings "all";
+use IO::Compress::Zip qw(:all);
+
+sub zlist(@);
+
+my @list;
+opendir DIR, "." || die;
+while (readdir(DIR)){
+	if ((-f $_) and ($_ =~ /\.fb2/)){ push @list, $_; }
+}
+closedir (DIR);
+
+zlist(@list);
+
+exit 0;
+
+sub zlist(@){
+	my @list = @_;
+	my $item;
+	foreach $item (@list)  {
+		printf ("zipping: %s to %s.zip", $item, $item);
+		zip [$item] => "$item.zip", -Level => Z_BEST_COMPRESSION, Minimal => 1, TextFlag => 1;
+		if(length($ZipError) > 0){
+			printf ("Warning: unable to zip %s - %s\n", $item, $ZipError);
+		}else{
+			printf (" and deleting source file\n");
+			unlink($item);
+		}
+
+	}
+}
+