Initial commit.
This commit is contained in:
eleksir
27
copier.pl
Executable file
27
copier.pl
Executable file
@@ -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);
|
||||||
|
|
||||||
6
cwnd.sh
Executable file
6
cwnd.sh
Executable file
@@ -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
|
||||||
47
dirlist.pl
Executable file
47
dirlist.pl
Executable file
@@ -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;
|
||||||
|
}
|
||||||
52
dns-hit.pl
Executable file
52
dns-hit.pl
Executable file
@@ -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;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
117
dns-tank-mt.pl
Executable file
117
dns-tank-mt.pl
Executable file
@@ -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;
|
||||||
|
}
|
||||||
89
dns-tank-st.pl
Executable file
89
dns-tank-st.pl
Executable file
@@ -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;
|
||||||
|
}
|
||||||
4
dnszone-bind2unbound.json
Normal file
4
dnszone-bind2unbound.json
Normal file
@@ -0,0 +1,4 @@
|
|||||||
|
{
|
||||||
|
"local" : "/home/eleksir/local.zone"
|
||||||
|
}
|
||||||
|
|
||||||
46
dnszone-bind2unbound.pl
Executable file
46
dnszone-bind2unbound.pl
Executable file
@@ -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";
|
||||||
|
}
|
||||||
|
}
|
||||||
291
i3status-mt-json
Executable file
291
i3status-mt-json
Executable file
@@ -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('');
|
||||||
|
}
|
||||||
|
|
||||||
140
munincurrency
Normal file
140
munincurrency
Normal file
@@ -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;
|
||||||
|
|
||||||
124
muninweather
Normal file
124
muninweather
Normal file
@@ -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;
|
||||||
|
}
|
||||||
385
p.pl
Executable file
385
p.pl
Executable file
@@ -0,0 +1,385 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings "all";
|
||||||
|
use Fcntl;
|
||||||
|
use BerkeleyDB;
|
||||||
|
|
||||||
|
my $str = '';
|
||||||
|
|
||||||
|
my $DIR = '/var/www/p.dafuq.ru/paste';
|
||||||
|
my $TSDB = "$DIR/timestamps.db";
|
||||||
|
my $DB = "$DIR/data.db";
|
||||||
|
my $URL = 'http://p.dafuq.ru/';
|
||||||
|
my $fsize = 262144;
|
||||||
|
my $minlen = 3;
|
||||||
|
my $maxlen = 9;
|
||||||
|
|
||||||
|
sub initdb();
|
||||||
|
sub showindex($);
|
||||||
|
sub eclient();
|
||||||
|
sub dclient();
|
||||||
|
sub getpaste($);
|
||||||
|
|
||||||
|
my $dbh = initdb();
|
||||||
|
showindex('') unless (defined($ENV{'REQUEST_METHOD'}));
|
||||||
|
|
||||||
|
if ($ENV{'REQUEST_METHOD'} eq 'GET'){
|
||||||
|
showindex('') unless (defined($ENV{'QUERY_STRING'}));
|
||||||
|
|
||||||
|
if ($ENV{'QUERY_STRING'} eq 'e'){
|
||||||
|
eclient();
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($ENV{'QUERY_STRING'} eq 'd'){
|
||||||
|
dclient();
|
||||||
|
}
|
||||||
|
|
||||||
|
getpaste($ENV{'QUERY_STRING'});
|
||||||
|
|
||||||
|
# assume POST(?) request
|
||||||
|
}elsif($ENV{'REQUEST_METHOD'} eq 'POST'){
|
||||||
|
|
||||||
|
showindex('') unless (defined($ENV{'CONTENT_LENGTH'}));
|
||||||
|
showindex('') if ($ENV{'CONTENT_LENGTH'} == '');
|
||||||
|
showindex('') if ($ENV{'CONTENT_LENGTH'} > $fsize);
|
||||||
|
showindex('') if ($ENV{'CONTENT_LENGTH'} eq '0');
|
||||||
|
|
||||||
|
my $fname;
|
||||||
|
# url key length should be 3-9 symbols
|
||||||
|
|
||||||
|
my $urllen = int(rand ($maxlen - $minlen)) + $minlen;
|
||||||
|
for(my $i = 0;$i < $urllen; $i++){
|
||||||
|
$fname .= ('a'..'z', 'A'..'Z')[int rand length(join('',('a'..'z', 'A'..'Z')))];
|
||||||
|
}
|
||||||
|
|
||||||
|
if ( $dbh->db_get($fname, undef) == 0 ){
|
||||||
|
# looks like we already have value here
|
||||||
|
# TODO: check timestamp!
|
||||||
|
if ( $dbh->db_del($fname) != 0 ){
|
||||||
|
# oops, error... how can it be here?
|
||||||
|
$str = 'Status: 500 Application Error
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
Application error - unable to delete key in $DB
|
||||||
|
';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $c = 0;
|
||||||
|
my $delim = '';
|
||||||
|
my $header = '';
|
||||||
|
my $char = '';
|
||||||
|
|
||||||
|
while(read(STDIN, $char, 1)){
|
||||||
|
# looks like this case is obviously sic, but... :)
|
||||||
|
if($c >= $ENV{'CONTENT_LENGTH'}){
|
||||||
|
$str = 'Status: 400 Bad Request
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
';
|
||||||
|
}
|
||||||
|
last if ($char eq "\n");
|
||||||
|
$delim .= $char;
|
||||||
|
$c++;
|
||||||
|
}
|
||||||
|
|
||||||
|
read(DATA, $char, 1);
|
||||||
|
|
||||||
|
while(read(STDIN, $char, 1)){
|
||||||
|
if($c >= $ENV{'CONTENT_LENGTH'}){
|
||||||
|
$str = 'Status: 400 Bad Request
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
';
|
||||||
|
}
|
||||||
|
|
||||||
|
last if ($char eq "\n");
|
||||||
|
$header .= $char;
|
||||||
|
$c++;
|
||||||
|
}
|
||||||
|
|
||||||
|
unless ($header =~ /Content-Disposition: form-data; name=.exs./) {
|
||||||
|
$str = 'Status: 400 Bad Request
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
Form should be multipart and parameter/field should be exs.';
|
||||||
|
syswrite STDOUT, $str;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
read(STDIN, $char, 2);
|
||||||
|
|
||||||
|
my $datalen = $ENV{'CONTENT_LENGTH'} - (length($delim) + 2 + length($header) + 4 + length($delim) + 3);
|
||||||
|
|
||||||
|
my $paste = '';
|
||||||
|
read(STDIN, $paste, $datalen);
|
||||||
|
|
||||||
|
# read one nl+cr
|
||||||
|
read(STDIN, $char, 1);
|
||||||
|
|
||||||
|
# read last delimiter
|
||||||
|
my $checkstr;
|
||||||
|
read(STDIN, $checkstr, (length($delim)));
|
||||||
|
|
||||||
|
# compare first delimiter and last one
|
||||||
|
chop($delim); chop($checkstr);
|
||||||
|
|
||||||
|
unless ($delim eq $checkstr){
|
||||||
|
$str .= 'Status: 400 Bad Request
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
';
|
||||||
|
}
|
||||||
|
|
||||||
|
$dbh->db_put($fname, $paste); # TODO: check status!
|
||||||
|
|
||||||
|
# if defined useragent and it doesen't match text browsers/download tools
|
||||||
|
# show fancy page
|
||||||
|
if (defined($ENV{'HTTP_USER_AGENT'})){
|
||||||
|
if (not($ENV{'HTTP_USER_AGENT'} =~ /^fetch libfetch/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^curl\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Wget\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Axel / or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^aria2\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Links \(/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Elinks( |\/)/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^w3m\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Lynx( |\/)/ )){
|
||||||
|
showindex("$URL$fname");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$str = "Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
$URL$fname
|
||||||
|
";
|
||||||
|
|
||||||
|
|
||||||
|
}else{
|
||||||
|
# unknown method or commandline call without correct environment
|
||||||
|
showindex('');
|
||||||
|
}
|
||||||
|
|
||||||
|
syswrite STDOUT, $str;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
sub initdb(){
|
||||||
|
my $dbh = undef;
|
||||||
|
unless (-f "$TSDB"){
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $TSDB,
|
||||||
|
-Flags => DB_CREATE
|
||||||
|
)
|
||||||
|
or die "Error opening $TSDB : $! $BerkeleyDB::Error\n";
|
||||||
|
}else{
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $TSDB,
|
||||||
|
)
|
||||||
|
or die "Error opening $TSDB : $! $BerkeleyDB::Error\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
unless (-f "$DB"){
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $DB,
|
||||||
|
-Flags => DB_CREATE
|
||||||
|
)
|
||||||
|
or die "Error opening $DB : $! $BerkeleyDB::Error\n";
|
||||||
|
}else{
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $DB,
|
||||||
|
)
|
||||||
|
or die "Error opening $DB : $! $BerkeleyDB::Error\n";
|
||||||
|
}
|
||||||
|
return $dbh;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub showindex($){
|
||||||
|
my $link = shift;
|
||||||
|
|
||||||
|
my $str = 'Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/html; charset=UTF-8
|
||||||
|
|
||||||
|
<!DOCTYPE html>
|
||||||
|
<html lang="ru">
|
||||||
|
<head>
|
||||||
|
<style>
|
||||||
|
body { background-color: #adc0fc; text-align: center; }
|
||||||
|
textarea {
|
||||||
|
background-image: url("http://img.dafuq.ru/bg_logo.png");
|
||||||
|
background-repeat: no-repeat;
|
||||||
|
background-position: center center;
|
||||||
|
width: 90%;
|
||||||
|
height: 70vh;
|
||||||
|
}
|
||||||
|
</style>
|
||||||
|
<title>Slack paste.</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<h3>Slack Paste</h3>
|
||||||
|
<form method="post" action="/" enctype="multipart/form-data">
|
||||||
|
<textarea name="exs" id="textbox" autofocus></textarea><br />
|
||||||
|
<input type="submit" value="Post it!" style="font-size:115%;" />
|
||||||
|
</form>';
|
||||||
|
|
||||||
|
if (defined($link) and $link ne ''){
|
||||||
|
$str .= "\n<p><table align=\"center\" frame=\"void\" border=\"0\"><td>$link</td></table></p>";
|
||||||
|
}
|
||||||
|
|
||||||
|
$str .= '
|
||||||
|
<p style="font-size: small;">
|
||||||
|
Console client can be found here: <a href="http://p.dafuq.ru/e">http://p.dafuq.ru/e</a> thanks <a href="http://sprunge.us">sprunge.us</a> for their client :)<br/>
|
||||||
|
More minimalist console client can be found here: <a href="http://p.dafuq.ru/d">http://p.dafuq.ru/d</a><br/>
|
||||||
|
<br/>
|
||||||
|
2015
|
||||||
|
</p>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
';
|
||||||
|
syswrite STDOUT, $str;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub eclient(){
|
||||||
|
$str = 'Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
Content-Disposition: attachment; filename="e";
|
||||||
|
|
||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
usage() {
|
||||||
|
description | fmt -s >&2
|
||||||
|
}
|
||||||
|
|
||||||
|
description() {
|
||||||
|
cat << HERE
|
||||||
|
|
||||||
|
DESCRIPTION
|
||||||
|
Upload data and fetch URL from the pastebin http://p.dafuq.ru/
|
||||||
|
|
||||||
|
USAGE
|
||||||
|
$0 filename.txt
|
||||||
|
$0 text string
|
||||||
|
$0 < filename.txt
|
||||||
|
piped_data | $0
|
||||||
|
|
||||||
|
NOTES
|
||||||
|
--------------------------------------------------------------------------
|
||||||
|
* INPUT METHODS *
|
||||||
|
$0 can accept piped data, STDIN redirection [<filename.txt], text strings following the command as arguments, or filenames as arguments. Only one of these methods can be used at a time, so please see the note on precedence. Also, note that using a pipe or STDIN redirection will treat tabs as spaces, or disregard them entirely (if they appear at the beginning of a line). So I suggest using a filename as an argument if tabs are important either to the function or readability of the code.
|
||||||
|
|
||||||
|
* PRECEDENCE *
|
||||||
|
STDIN redirection has precedence, then piped input, then a filename as an argument, and finally text strings as an arguments.
|
||||||
|
|
||||||
|
EXAMPLE:
|
||||||
|
echo piped | "$0" arguments.txt < stdin_redirection.txt
|
||||||
|
|
||||||
|
In this example, the contents of file_as_stdin_redirection.txt would be uploaded. Both the piped_text and the file_as_argument.txt are ignored. If there is piped input and arguments, the arguments will be ignored, and the piped input uploaded.
|
||||||
|
|
||||||
|
* FILENAMES *
|
||||||
|
If a filename is misspelled or doesn\'t have the necessary path description, it will NOT generate an error, but will instead treat it as a text string and upload it.
|
||||||
|
--------------------------------------------------------------------------
|
||||||
|
|
||||||
|
HERE
|
||||||
|
exit
|
||||||
|
}
|
||||||
|
|
||||||
|
if [ -t 0 ]; then
|
||||||
|
echo Running interactively, checking for arguments... >&2
|
||||||
|
if [ "$*" ]; then
|
||||||
|
echo Arguments present... >&2
|
||||||
|
if [ -f "$*" ]; then
|
||||||
|
echo Uploading the contents of "$*"... >&2
|
||||||
|
cat "$*"
|
||||||
|
else
|
||||||
|
echo Uploading the text: \""$*"\"... >&2
|
||||||
|
echo "$*"
|
||||||
|
fi | curl -F "exs=<-" http://p.dafuq.ru/
|
||||||
|
else
|
||||||
|
echo No arguments found, printing USAGE and exiting. >&2
|
||||||
|
usage
|
||||||
|
fi
|
||||||
|
else
|
||||||
|
echo Using input from a pipe or STDIN redirection... >&2
|
||||||
|
while read -r line ; do
|
||||||
|
echo $line
|
||||||
|
done | curl -F "exs=<-" http://p.dafuq.ru/
|
||||||
|
fi
|
||||||
|
';
|
||||||
|
syswrite STDOUT, $str;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub dclient(){
|
||||||
|
$str = 'Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/plain
|
||||||
|
Content-Disposition: attachment; filename="d";
|
||||||
|
|
||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
if [[ "$1" == "--help" ]]; then
|
||||||
|
echo "Usage: $0 < file"
|
||||||
|
echo " echo foo | $0"
|
||||||
|
elif [[ -f "$1" ]]; then
|
||||||
|
curl -F "exs=<-" "http://p.dafuq.ru" <"$1"
|
||||||
|
else
|
||||||
|
curl -F "exs=<-" "http://p.dafuq.ru"
|
||||||
|
fi
|
||||||
|
|
||||||
|
exit 0
|
||||||
|
';
|
||||||
|
syswrite STDOUT, $str;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getpaste($){
|
||||||
|
my $id = shift;
|
||||||
|
my $str = '';
|
||||||
|
if ( $dbh->db_get($id, $str) == 0 ){
|
||||||
|
$str = "Status: 200 OK
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
|
||||||
|
$str";
|
||||||
|
}else{
|
||||||
|
$str = "Status: 404 Not Found
|
||||||
|
Content-type: text/plain
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
|
||||||
|
No such paste.
|
||||||
|
";
|
||||||
|
}
|
||||||
|
|
||||||
|
syswrite STDOUT, $str;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
__END__
|
||||||
|
|
||||||
292
paste.pl
Executable file
292
paste.pl
Executable file
@@ -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> 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__
|
||||||
381
paste2.pl
Executable file
381
paste2.pl
Executable file
@@ -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> 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__
|
||||||
|
|
||||||
86
rle.pl
Normal file
86
rle.pl
Normal file
@@ -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;
|
||||||
195
shorten.old.pl
Executable file
195
shorten.old.pl
Executable file
@@ -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>
|
||||||
315
shorten.pl
Executable file
315
shorten.pl
Executable file
@@ -0,0 +1,315 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
# vim: set ft=perl ts=8 sw=8 sts=8 ai et :
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings "all";
|
||||||
|
use Fcntl;
|
||||||
|
|
||||||
|
use BerkeleyDB;
|
||||||
|
|
||||||
|
use CGI qw/:standard/;
|
||||||
|
use CGI::Carp 'fatalsToBrowser';
|
||||||
|
$CGI::POST_MAX=1024 * 2; # max 2K posts
|
||||||
|
$CGI::DISABLE_UPLOADS = 1; # no uploads
|
||||||
|
|
||||||
|
my $datapath = '/var/www/s.dafuq.ru/data/';
|
||||||
|
my $db = $datapath . '/short.links.bdb';
|
||||||
|
my $tsdb = $datapath . '/timestamps.bdb';
|
||||||
|
my $expiresdb = $datapath . '/expires.bdb';
|
||||||
|
|
||||||
|
my $str = '';
|
||||||
|
my $url;
|
||||||
|
my $hostname = $ENV{'HTTP_HOST'};
|
||||||
|
my $ts = time();
|
||||||
|
|
||||||
|
sub indexpage($);
|
||||||
|
sub _initdb($);
|
||||||
|
sub initdb();
|
||||||
|
sub http200($);
|
||||||
|
sub http400($);
|
||||||
|
sub http404($);
|
||||||
|
sub http500($);
|
||||||
|
sub genlinkname();
|
||||||
|
sub _urldecode($);
|
||||||
|
|
||||||
|
my ($dbh, $tsdbh, $expdbh) = initdb();
|
||||||
|
|
||||||
|
if ((defined($ARGV[0])) and ($ARGV[0] ne 'index.html')){ # some web-servers add index page, quirk it
|
||||||
|
# we got GET req. here, so let's redirect it.
|
||||||
|
my $status = $dbh->db_get($ARGV[0], $url);
|
||||||
|
|
||||||
|
if ($status == 0) {
|
||||||
|
my $expires;
|
||||||
|
$status = $expdbh->db_get($ARGV[0], $expires);
|
||||||
|
|
||||||
|
if ($status != 0){
|
||||||
|
# expires time stamp missing
|
||||||
|
$expires = $ts + (60*60*24*3*6);
|
||||||
|
$expdbh->db_put($ARGV[0], $expires);
|
||||||
|
}
|
||||||
|
|
||||||
|
if($ts > $expires){
|
||||||
|
http404("Link expired. ts = $ts, expires = $expires");
|
||||||
|
}
|
||||||
|
|
||||||
|
syswrite STDOUT, redirect($url);
|
||||||
|
exit 0;
|
||||||
|
} else {
|
||||||
|
http404("Link not exist.");
|
||||||
|
}
|
||||||
|
|
||||||
|
}else{
|
||||||
|
# we got page/form request, or post link request
|
||||||
|
|
||||||
|
if($ENV{'REQUEST_METHOD'} eq 'POST'){ # post link request
|
||||||
|
# here we need to extract the link
|
||||||
|
my $buf = _urldecode(param('exs'));
|
||||||
|
|
||||||
|
if(($buf =~ /^http:/) or
|
||||||
|
($buf =~ /^https:/) or
|
||||||
|
($buf =~ /^ftp:/) or
|
||||||
|
($buf =~ /^xmpp:/) or
|
||||||
|
($buf =~ /^ipp:/) or
|
||||||
|
($buf =~ /^ldap:/) or
|
||||||
|
($buf =~ /^ldaps:/) or
|
||||||
|
($buf =~ /^irc:/) or
|
||||||
|
($buf =~ /^ircs:/) or
|
||||||
|
($buf =~ /^ssh:/) or
|
||||||
|
($buf =~ /^svn:/) or
|
||||||
|
($buf =~ /^git:/) or
|
||||||
|
($buf =~ /^hg:/) or
|
||||||
|
($buf =~ /^rtmp:/) or
|
||||||
|
($buf =~ /^rtsp:/) or
|
||||||
|
($buf =~ /^rtp:/) or
|
||||||
|
($buf =~ /^shoutcast:/) or
|
||||||
|
($buf =~ /^icecast:/) or
|
||||||
|
($buf =~ /^mailto:/) or
|
||||||
|
($buf =~ /^smb:/) or
|
||||||
|
($buf =~ /^magnet:/) or
|
||||||
|
($buf =~ /^ed2k:/) or
|
||||||
|
($buf =~ /^skype:/) or
|
||||||
|
($buf =~ /^dav:/) or
|
||||||
|
($buf =~ /^h323:/) or
|
||||||
|
($buf =~ /^rsync:/) or
|
||||||
|
($buf =~ /^sftp:/)){
|
||||||
|
}else{
|
||||||
|
http400('Invalid url.');
|
||||||
|
}
|
||||||
|
|
||||||
|
my $name = genlinkname;
|
||||||
|
|
||||||
|
$dbh->db_put($name, $buf);
|
||||||
|
$tsdbh->db_put($name, $ts);
|
||||||
|
|
||||||
|
my $ets = $ts + (60 * 60 * 24 * 30 * 6);
|
||||||
|
my $etime = param('etime');
|
||||||
|
|
||||||
|
if (defined($etime)){
|
||||||
|
if ($etime == '1'){
|
||||||
|
$ets = $ts + (60*60); # 1 hour
|
||||||
|
}elsif ($etime == '2'){
|
||||||
|
$ets = $ts + (60*60*12); # 12 hours
|
||||||
|
}elsif ($etime == '3' ){
|
||||||
|
$ets = $ts + (60*60*24); # 1 day
|
||||||
|
}elsif ($etime == '4' ){
|
||||||
|
$ets = $ts + (60*60*24*7); # 1 week
|
||||||
|
}elsif ($etime == '5' ){
|
||||||
|
$ets = $ts + (60*60*24*30); # 1 month
|
||||||
|
}elsif ($etime == '6' ){
|
||||||
|
$ets = $ts + (60*60*24*30*3); # 3 months
|
||||||
|
}elsif ($etime == '7' ){
|
||||||
|
$ets = $ts + (60*60*24*30*6); # 6 months
|
||||||
|
}elsif ($etime == '8' ){
|
||||||
|
$ets = $ts + (60*60*24*30*12); # 1 year
|
||||||
|
}elsif ($etime == '9' ){
|
||||||
|
$ets = $ts + (60*60*24*30*24); # 2 years
|
||||||
|
}elsif ($etime == '10' ){
|
||||||
|
$ets = $ts + (60*60*24*30*36); # 3 years
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$expdbh->db_put($name, $ets);
|
||||||
|
# here we need to post form with extracted link or just string
|
||||||
|
|
||||||
|
if (defined($ENV{'HTTP_USER_AGENT'})){
|
||||||
|
if (not($ENV{'HTTP_USER_AGENT'} =~ /^fetch libfetch/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^curl\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Wget\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Axel / or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^aria2\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Links \(/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Elinks( |\/)/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^w3m\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Lynx( |\/)/ )){
|
||||||
|
indexpage("http://$hostname/$name");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
http200("http://$hostname/$name");
|
||||||
|
}else{
|
||||||
|
# we got form request with GET/HEAD method, so print it
|
||||||
|
indexpage('');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub indexpage($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, <<DATA
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/html
|
||||||
|
|
||||||
|
<!DOCTYPE html>
|
||||||
|
<html lang="ru">
|
||||||
|
<head>
|
||||||
|
<meta charset="UTF-8" />
|
||||||
|
<style>
|
||||||
|
* {
|
||||||
|
margin: 10px;
|
||||||
|
text-align: center;
|
||||||
|
font-size: 14pt;
|
||||||
|
}
|
||||||
|
html, body {
|
||||||
|
background-color: #adc0fc;
|
||||||
|
}
|
||||||
|
</style>
|
||||||
|
<title>SlackPaste</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<img src="http://img.dafuq.ru/logo.png" />
|
||||||
|
|
||||||
|
<form method="post" action="/">
|
||||||
|
Shorten this link:<br />
|
||||||
|
<input type="text" size="30" maxlength="768" name="exs" style="font-size: 110%;" autofocus/></br />
|
||||||
|
<input type="submit" value="Submit" style="font-size: 85%;" />
|
||||||
|
<select name="etime" style="font-size: 85%; text-align:left;">
|
||||||
|
<option value="1" style="font-size: 85%; text-align:left;">1 Hour</option>
|
||||||
|
<option value="2" style="font-size: 85%; text-align:left;">12 Hours</option>
|
||||||
|
<option value="3" style="font-size: 85%; text-align:left;">1 day</option>
|
||||||
|
<option value="4" style="font-size: 85%; text-align:left;">1 week</option>
|
||||||
|
<option value="5" style="font-size: 85%; text-align:left;">1 Month</option>
|
||||||
|
<option value="6" style="font-size: 85%; text-align:left;">3 Months</option>
|
||||||
|
<option value="7" selected style="font-size: 85%; text-align:left;">6 Months</option>
|
||||||
|
<option value="8" style="font-size: 85%; text-align:left;">1 Year</option>
|
||||||
|
<option value="9" style="font-size: 85%; text-align:left;">2 Years</option>
|
||||||
|
<option value="10" style="font-size: 85%; text-align:left;">3 Years</option>
|
||||||
|
</select>
|
||||||
|
</form>
|
||||||
|
DATA
|
||||||
|
;
|
||||||
|
if((defined($str)) and ($str ne '')) { syswrite STDOUT, "<p>$str</p>"; }
|
||||||
|
syswrite STDOUT, <<DATA
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
||||||
|
DATA
|
||||||
|
;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _initdb($){
|
||||||
|
my $db = shift;
|
||||||
|
my $dbh = undef;
|
||||||
|
unless (-f "$db"){
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $db,
|
||||||
|
-Flags => DB_CREATE
|
||||||
|
)
|
||||||
|
or die "Error opening $db : $! $BerkeleyDB::Error\n";
|
||||||
|
}else{
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $db,
|
||||||
|
)
|
||||||
|
or die "Error opening $db : $! $BerkeleyDB::Error\n";
|
||||||
|
}
|
||||||
|
return $dbh;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub initdb(){
|
||||||
|
my @array;
|
||||||
|
foreach($db, $tsdb, $expiresdb){
|
||||||
|
push @array, _initdb($_);
|
||||||
|
}
|
||||||
|
return @array;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub http200($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, header(-"Cache-Control"=>"no-store, no-cache, must-revalidate",
|
||||||
|
-pragma => "no-cache",
|
||||||
|
-type => "text/plain", -charset => "utf-8") . $str;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub http400($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, "Status: 400 Bad Request
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
$str
|
||||||
|
";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub http404($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, "Status: 404 Not Found
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
$str
|
||||||
|
";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
sub genlinkname(){
|
||||||
|
my $count = 0;
|
||||||
|
my $name = '';
|
||||||
|
my $status = 1;
|
||||||
|
# make collision possibility minimal :)
|
||||||
|
do {
|
||||||
|
last if($count > 1000);
|
||||||
|
|
||||||
|
# it should'a be really big amount of links :)
|
||||||
|
my $nlen = (int rand 6) + 3;
|
||||||
|
for(my $i = 0; $i < $nlen; $i++){
|
||||||
|
$name .= ('a'..'z', 'A'..'Z')[int rand length(join('',('a'..'z', 'A'..'Z')))];
|
||||||
|
}
|
||||||
|
$status = $dbh->db_get($name, undef);
|
||||||
|
$count++;
|
||||||
|
} unless ($status == 0);
|
||||||
|
http400('Namespace exhausted.') if($status == 0);
|
||||||
|
return $name;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _urldecode($){
|
||||||
|
my $string = shift;
|
||||||
|
$string =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
|
||||||
|
return $string;
|
||||||
|
}
|
||||||
|
__END__
|
||||||
|
|
||||||
|
По сравнению с оргинальной версией сделано:
|
||||||
|
Чистка кода,
|
||||||
|
Перевод кода на CGI.pm, всё ровно в последствии надо будет извлекать несколько параметров из POST-а
|
||||||
|
реализация мех-ма со сроком хранения ссылок
|
||||||
|
реализация web-api для выбора предопределённых периодов хранения
|
||||||
|
|
||||||
|
|
||||||
|
<!DOCTYPE HTML>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<title>Exs URL Shortner.</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<form method="post" action="/s/">
|
||||||
|
<p style="text-align: center;"><b>URL Shortner</b></p>
|
||||||
|
<div style="text-align: center;"><input type="text" size="30" maxlength="256" name="exs" style="font-size:125%;"></div>
|
||||||
|
<p style="text-align: center;"><input type="submit" value="Shorten!"></p>
|
||||||
|
</form>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
315
shorten2.pl
Executable file
315
shorten2.pl
Executable file
@@ -0,0 +1,315 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
# vim: set ft=perl ts=8 sw=8 sts=8 ai et :
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings "all";
|
||||||
|
use Fcntl;
|
||||||
|
|
||||||
|
use BerkeleyDB;
|
||||||
|
|
||||||
|
use CGI qw/:standard/;
|
||||||
|
use CGI::Carp 'fatalsToBrowser';
|
||||||
|
$CGI::POST_MAX=1024 * 2; # max 2K posts
|
||||||
|
$CGI::DISABLE_UPLOADS = 1; # no uploads
|
||||||
|
|
||||||
|
my $datapath = '/var/www/s.dafuq.ru/data/';
|
||||||
|
my $db = $datapath . '/short.links.bdb';
|
||||||
|
my $tsdb = $datapath . '/timestamps.bdb';
|
||||||
|
my $expiresdb = $datapath . '/expires.bdb';
|
||||||
|
|
||||||
|
my $str = '';
|
||||||
|
my $url;
|
||||||
|
my $hostname = $ENV{'HTTP_HOST'};
|
||||||
|
my $ts = time();
|
||||||
|
|
||||||
|
sub indexpage($);
|
||||||
|
sub _initdb($);
|
||||||
|
sub initdb();
|
||||||
|
sub http200($);
|
||||||
|
sub http400($);
|
||||||
|
sub http404($);
|
||||||
|
sub http500($);
|
||||||
|
sub genlinkname();
|
||||||
|
sub _urldecode($);
|
||||||
|
|
||||||
|
my ($dbh, $tsdbh, $expdbh) = initdb();
|
||||||
|
|
||||||
|
if ((defined($ARGV[0])) and ($ARGV[0] ne 'index.html')){ # some web-servers add index page, quirk it
|
||||||
|
# we got GET req. here, so let's redirect it.
|
||||||
|
my $status = $dbh->db_get($ARGV[0], $url);
|
||||||
|
|
||||||
|
if ($status == 0) {
|
||||||
|
my $expires;
|
||||||
|
$status = $expdbh->db_get($ARGV[0], $expires);
|
||||||
|
|
||||||
|
if ($status != 0){
|
||||||
|
# expires time stamp missing
|
||||||
|
$expires = $ts + (60*60*24*3*6);
|
||||||
|
$expdbh->db_put($ARGV[0], $expires);
|
||||||
|
}
|
||||||
|
|
||||||
|
if($ts > $expires){
|
||||||
|
http404("Link expired. ts = $ts, expires = $expires");
|
||||||
|
}
|
||||||
|
|
||||||
|
syswrite STDOUT, redirect($url);
|
||||||
|
exit 0;
|
||||||
|
} else {
|
||||||
|
http404("Link not exist.");
|
||||||
|
}
|
||||||
|
|
||||||
|
}else{
|
||||||
|
# we got page/form request, or post link request
|
||||||
|
|
||||||
|
if($ENV{'REQUEST_METHOD'} eq 'POST'){ # post link request
|
||||||
|
# here we need to extract the link
|
||||||
|
my $buf = _urldecode(param('exs'));
|
||||||
|
|
||||||
|
if(($buf =~ /^http:/) or
|
||||||
|
($buf =~ /^https:/) or
|
||||||
|
($buf =~ /^ftp:/) or
|
||||||
|
($buf =~ /^xmpp:/) or
|
||||||
|
($buf =~ /^ipp:/) or
|
||||||
|
($buf =~ /^ldap:/) or
|
||||||
|
($buf =~ /^ldaps:/) or
|
||||||
|
($buf =~ /^irc:/) or
|
||||||
|
($buf =~ /^ircs:/) or
|
||||||
|
($buf =~ /^ssh:/) or
|
||||||
|
($buf =~ /^svn:/) or
|
||||||
|
($buf =~ /^git:/) or
|
||||||
|
($buf =~ /^hg:/) or
|
||||||
|
($buf =~ /^rtmp:/) or
|
||||||
|
($buf =~ /^rtsp:/) or
|
||||||
|
($buf =~ /^rtp:/) or
|
||||||
|
($buf =~ /^shoutcast:/) or
|
||||||
|
($buf =~ /^icecast:/) or
|
||||||
|
($buf =~ /^mailto:/) or
|
||||||
|
($buf =~ /^smb:/) or
|
||||||
|
($buf =~ /^magnet:/) or
|
||||||
|
($buf =~ /^ed2k:/) or
|
||||||
|
($buf =~ /^skype:/) or
|
||||||
|
($buf =~ /^dav:/) or
|
||||||
|
($buf =~ /^h323:/) or
|
||||||
|
($buf =~ /^rsync:/) or
|
||||||
|
($buf =~ /^sftp:/)){
|
||||||
|
}else{
|
||||||
|
http400('Invalid url.');
|
||||||
|
}
|
||||||
|
|
||||||
|
my $name = genlinkname;
|
||||||
|
|
||||||
|
$dbh->db_put($name, $buf);
|
||||||
|
$tsdbh->db_put($name, $ts);
|
||||||
|
|
||||||
|
my $ets = $ts + (60 * 60 * 24 * 30 * 6);
|
||||||
|
my $etime = param('etime');
|
||||||
|
|
||||||
|
if (defined($etime)){
|
||||||
|
if ($etime == '1'){
|
||||||
|
$ets = $ts + (60*60); # 1 hour
|
||||||
|
}elsif ($etime == '2'){
|
||||||
|
$ets = $ts + (60*60*12); # 12 hours
|
||||||
|
}elsif ($etime == '3' ){
|
||||||
|
$ets = $ts + (60*60*24); # 1 day
|
||||||
|
}elsif ($etime == '4' ){
|
||||||
|
$ets = $ts + (60*60*24*7); # 1 week
|
||||||
|
}elsif ($etime == '5' ){
|
||||||
|
$ets = $ts + (60*60*24*30); # 1 month
|
||||||
|
}elsif ($etime == '6' ){
|
||||||
|
$ets = $ts + (60*60*24*30*3); # 3 months
|
||||||
|
}elsif ($etime == '7' ){
|
||||||
|
$ets = $ts + (60*60*24*30*6); # 6 months
|
||||||
|
}elsif ($etime == '8' ){
|
||||||
|
$ets = $ts + (60*60*24*30*12); # 1 year
|
||||||
|
}elsif ($etime == '9' ){
|
||||||
|
$ets = $ts + (60*60*24*30*24); # 2 years
|
||||||
|
}elsif ($etime == '10' ){
|
||||||
|
$ets = $ts + (60*60*24*30*36); # 3 years
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$expdbh->db_put($name, $ets);
|
||||||
|
# here we need to post form with extracted link or just string
|
||||||
|
|
||||||
|
if (defined($ENV{'HTTP_USER_AGENT'})){
|
||||||
|
if (not($ENV{'HTTP_USER_AGENT'} =~ /^fetch libfetch/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^curl\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Wget\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Axel / or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^aria2\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Links \(/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Elinks( |\/)/ or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^w3m\// or
|
||||||
|
$ENV{'HTTP_USER_AGENT'} =~ /^Lynx( |\/)/ )){
|
||||||
|
indexpage("http://$hostname/$name");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
http200("http://$hostname/$name");
|
||||||
|
}else{
|
||||||
|
# we got form request with GET/HEAD method, so print it
|
||||||
|
indexpage('');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub indexpage($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, <<DATA
|
||||||
|
Pragma: no-cache
|
||||||
|
Cache-Control: no-cache
|
||||||
|
Content-Language: en, ru
|
||||||
|
Content-type: text/html
|
||||||
|
|
||||||
|
<!DOCTYPE html>
|
||||||
|
<html lang="ru">
|
||||||
|
<head>
|
||||||
|
<meta charset="UTF-8" />
|
||||||
|
<style>
|
||||||
|
* {
|
||||||
|
margin: 10px;
|
||||||
|
text-align: center;
|
||||||
|
font-size: 14pt;
|
||||||
|
}
|
||||||
|
html, body {
|
||||||
|
background-color: #adc0fc;
|
||||||
|
}
|
||||||
|
</style>
|
||||||
|
<title>SlackPaste</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<img src="http://img.dafuq.ru/logo.png" />
|
||||||
|
|
||||||
|
<form method="post" action="/">
|
||||||
|
Shorten this link:<br />
|
||||||
|
<input type="text" size="30" maxlength="768" name="exs" style="font-size: 110%;" autofocus/></br />
|
||||||
|
<input type="submit" value="Submit" style="font-size: 85%;" />
|
||||||
|
<select name="etime" style="font-size: 85%; text-align:left;">
|
||||||
|
<option value="1" style="font-size: 85%; text-align:left;">1 Hour</option>
|
||||||
|
<option value="2" style="font-size: 85%; text-align:left;">12 Hours</option>
|
||||||
|
<option value="3" style="font-size: 85%; text-align:left;">1 day</option>
|
||||||
|
<option value="4" style="font-size: 85%; text-align:left;">1 week</option>
|
||||||
|
<option value="5" style="font-size: 85%; text-align:left;">1 Month</option>
|
||||||
|
<option value="6" style="font-size: 85%; text-align:left;">3 Months</option>
|
||||||
|
<option value="7" selected style="font-size: 85%; text-align:left;">6 Months</option>
|
||||||
|
<option value="8" style="font-size: 85%; text-align:left;">1 Year</option>
|
||||||
|
<option value="9" style="font-size: 85%; text-align:left;">2 Years</option>
|
||||||
|
<option value="10" style="font-size: 85%; text-align:left;">3 Years</option>
|
||||||
|
</select>
|
||||||
|
</form>
|
||||||
|
DATA
|
||||||
|
;
|
||||||
|
if((defined($str)) and ($str ne '')) { syswrite STDOUT, "<p>$str</p>"; }
|
||||||
|
syswrite STDOUT, <<DATA
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
||||||
|
DATA
|
||||||
|
;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _initdb($){
|
||||||
|
my $db = shift;
|
||||||
|
my $dbh = undef;
|
||||||
|
unless (-f "$db"){
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $db,
|
||||||
|
-Flags => DB_CREATE
|
||||||
|
)
|
||||||
|
or die "Error opening $db : $! $BerkeleyDB::Error\n";
|
||||||
|
}else{
|
||||||
|
$dbh = new BerkeleyDB::Hash(
|
||||||
|
-Filename => $db,
|
||||||
|
)
|
||||||
|
or die "Error opening $db : $! $BerkeleyDB::Error\n";
|
||||||
|
}
|
||||||
|
return $dbh;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub initdb(){
|
||||||
|
my @array;
|
||||||
|
foreach($db, $tsdb, $expiresdb){
|
||||||
|
push @array, _initdb($_);
|
||||||
|
}
|
||||||
|
return @array;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub http200($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, header(-"Cache-Control"=>"no-store, no-cache, must-revalidate",
|
||||||
|
-pragma => "no-cache",
|
||||||
|
-type => "text/plain", -charset => "utf-8") . $str;
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub http400($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, "Status: 400 Bad Request
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
$str
|
||||||
|
";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub http404($){
|
||||||
|
my $str = shift;
|
||||||
|
syswrite STDOUT, "Status: 404 Not Found
|
||||||
|
Content-type: text/plain
|
||||||
|
|
||||||
|
$str
|
||||||
|
";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
sub genlinkname(){
|
||||||
|
my $count = 0;
|
||||||
|
my $name = '';
|
||||||
|
my $status = 1;
|
||||||
|
# make collision possibility minimal :)
|
||||||
|
do {
|
||||||
|
last if($count > 1000);
|
||||||
|
|
||||||
|
# it should'a be really big amount of links :)
|
||||||
|
my $nlen = (int rand 6) + 3;
|
||||||
|
for(my $i = 0; $i < $nlen; $i++){
|
||||||
|
$name .= ('a'..'z', 'A'..'Z')[int rand length(join('',('a'..'z', 'A'..'Z')))];
|
||||||
|
}
|
||||||
|
$status = $dbh->db_get($name, undef);
|
||||||
|
$count++;
|
||||||
|
} unless ($status == 0);
|
||||||
|
http400('Namespace exhausted.') if($status == 0);
|
||||||
|
return $name;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _urldecode($){
|
||||||
|
my $string = shift;
|
||||||
|
$string =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
|
||||||
|
return $string;
|
||||||
|
}
|
||||||
|
__END__
|
||||||
|
|
||||||
|
По сравнению с оргинальной версией сделано:
|
||||||
|
Чистка кода,
|
||||||
|
Перевод кода на CGI.pm, всё ровно в последствии надо будет извлекать несколько параметров из POST-а
|
||||||
|
реализация мех-ма со сроком хранения ссылок
|
||||||
|
реализация web-api для выбора предопределённых периодов хранения
|
||||||
|
|
||||||
|
|
||||||
|
<!DOCTYPE HTML>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<meta charset="utf-8">
|
||||||
|
<title>Exs URL Shortner.</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<form method="post" action="/s/">
|
||||||
|
<p style="text-align: center;"><b>URL Shortner</b></p>
|
||||||
|
<div style="text-align: center;"><input type="text" size="30" maxlength="256" name="exs" style="font-size:125%;"></div>
|
||||||
|
<p style="text-align: center;"><input type="submit" value="Shorten!"></p>
|
||||||
|
</form>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
69
unrle.pl
Normal file
69
unrle.pl
Normal file
@@ -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;
|
||||||
101
wp.pl
Executable file
101
wp.pl
Executable file
@@ -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);
|
||||||
|
|
||||||
62
yagecibycocin.pl
Executable file
62
yagecibycocin.pl
Executable file
@@ -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;
|
||||||
|
}
|
||||||
38
zip_fb2.pl
Executable file
38
zip_fb2.pl
Executable file
@@ -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);
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
Reference in New Issue
Block a user