commit 82b0cfbcc286a14bb6dfd097bf26b684b8e3572f Author: eleksir Date: Sat Sep 3 22:38:52 2016 +0300 Initial commit. 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 (){ + 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 (){ + 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 = ; +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 = ; + 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 = ; + 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 = ; + close A; + chomp($P); + + if($P eq '1'){ + open A, "/sys/class/power_supply/BAT0/energy_full"; + my $full_charge = ; chomp($full_charge); close A; + open A, "/sys/class/power_supply/BAT0/energy_now"; + my $current_charge = ; 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( == 1){ + $str .= "AC"; + }else{ + $str .= "DC"; + } + + close AC; # display % charge only if possible + if (open DC,"/sys/class/power_supply/BAT0/capacity"){ + my $charge = ; + 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(/
/, $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/
//;} + 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 =~ /(\d+\,?\d*)<\/td>/){ + $alfadollarbuy = $1; + $alfadollarbuy =~ s/,/\./; +} +if ($data =~ /(\d+\,?\d*)<\/td>/){ + $alfadollarsell = $1; + $alfadollarsell =~ s/,/\./; +} + +if ($data =~ /(\d+\,?\d*)<\/td>/){ + $alfaeurobuy = $1; + $alfaeurobuy =~ s/,/\./; +} +if ($data =~ /(\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+\s+(\d\d\,\d\d)\s+<\/td>\s+\s+(\d\d\,\d\d)\s+<\/td>/){ + $bmdollarsell = $2; + $bmdollarbuy = $1; + $bmdollarsell =~ s/,/\./; + $bmdollarbuy =~ s/,/\./; +} +if($data =~ /ЕВРО\s+<\/td>\s+\s+(\d\d\,\d\d)\s+<\/td>\s+\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+\s*/, $data))[1]))[0]; +$sberdollarbu =~ s/,/\./; +my $sberdollarsell = (split(/\s+\s*/, $data))[2]))[0]; +$sberdollarsel =~ s/,/\./; +my $sbereurobuy = (split(/\s+/, (split (/\s*/, $data))[3]))[0]; +$sbereurobuy =~ s/,/\./; +my $sbereurosell = (split(/\s+/, (split (/\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 <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 + + + + + + Slack paste. + + +

Slack Paste

+
+
+ +
'; + + if (defined($link) and $link ne ''){ + $str .= "\n

$link

"; + } + + $str .= ' +

+ Console client can be found here: http://p.dafuq.ru/e    thanks sprunge.us for their client :)
+ More minimalist console client can be found here: http://p.dafuq.ru/d
+
+ 2015 +

+ + +'; + 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 [&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 [&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(){ + $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 + + + + + + Slack paste. + + + +

Slack Paste

+
+
+ +
+

Console client can be found here: http://p.dafuq.ru/e    thanks sprunge.us for their client :)
+ More minimalist console client can be found here: http://p.dafuq.ru/d
+
+ 2015

+ + +'; + } +} + +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 + + + + + + Slack paste. + + +

Slack Paste

+
+
+ +
'; + + if (defined($link) and $link ne ''){ + $str .= "\n

$link

"; + } + + $str .= ' +

+ Console client can be found here: http://p.dafuq.ru/e    thanks sprunge.us for their client :)
+ More minimalist console client can be found here: http://p.dafuq.ru/d
+
+ 2015 +

+ + +'; + 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 [&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 \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 + + + + + + + exs-elm.ru + + + + +
+ Shorten this link:
+
+ +
+ + + +'; + + } +} + +syswrite STDOUT, $str; +exit 0; + +__END__ + +всего 3 типа запросов +-на показ формы +-на аплод ссылки из формы/аплоад ссылки из ком.строки +-на редирект по ссылке + + + + + + + + + +Exs URL Shortner. + + +
+

URL Shortner

+
+

+
+ + 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, < + + + + + SlackPaste + + + + +
+ Shorten this link:
+
+ + +
+DATA +; + if((defined($str)) and ($str ne '')) { syswrite STDOUT, "

$str

"; } + syswrite STDOUT, < + + +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 для выбора предопределённых периодов хранения + + + + + + +Exs URL Shortner. + + +
+

URL Shortner

+
+

+
+ + 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, < + + + + + SlackPaste + + + + +
+ Shorten this link:
+
+ + +
+DATA +; + if((defined($str)) and ($str ne '')) { syswrite STDOUT, "

$str

"; } + syswrite STDOUT, < + + +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 для выбора предопределённых периодов хранения + + + + + + +Exs URL Shortner. + + +
+

URL Shortner

+
+

+
+ + 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 \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} = <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 < "$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); + } + + } +} +