WIP Adding paste and image download modules
* Adding link shortener/paste module * Adding image downloder * Added TODO/Wish list * add Exporter to modules
This commit is contained in:
10
TODO
Normal file
10
TODO
Normal file
@@ -0,0 +1,10 @@
|
||||
* image 'stream' (wallpaper/just image)
|
||||
* weather grab
|
||||
* currency grab
|
||||
* joyreactor video grab/stream
|
||||
* jabber client (send message on demand)
|
||||
* irc client (send message on demand)
|
||||
* paste/link shortener
|
||||
* shortener api for goo.gl or same services
|
||||
* paste api for some pastebins
|
||||
* image downloader
|
||||
@@ -1,5 +1,9 @@
|
||||
{
|
||||
"api" : {
|
||||
"prefix" : "/api"
|
||||
},
|
||||
"image_dl" : {
|
||||
"dir" : "/home/eleksr/img-save",
|
||||
"sleep" : 10
|
||||
}
|
||||
}
|
||||
|
||||
@@ -6,6 +6,9 @@ use vars qw/$VERSION/;
|
||||
|
||||
$VERSION = "1.0";
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT = qw(quote chanserv nickserv me);
|
||||
|
||||
sub quote {
|
||||
if (-f "/usr/games/fortune") {
|
||||
return ('200', 'text/plain', `fortune`);
|
||||
|
||||
135
lib/image_dl.pm
Normal file
135
lib/image_dl.pm
Normal file
@@ -0,0 +1,135 @@
|
||||
package image_dl;
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
use HTTP::Tiny;
|
||||
use Net::SSLeay;
|
||||
use IO::Socket::SSL;
|
||||
use Image::Magick;
|
||||
|
||||
use Exporter qw(import);
|
||||
use vars qw/$VERSION/;
|
||||
$VERSION = "1.0";
|
||||
our @EXPORT = qw(queue_image dl_thread);
|
||||
|
||||
|
||||
|
||||
sub queue_image (@) {
|
||||
my $url = shift;
|
||||
my $images = shift;
|
||||
push @{$images}, $url;
|
||||
return('200', 'text/plain', "Download queued\n");
|
||||
}
|
||||
|
||||
sub __urlencode($) {
|
||||
my $url = shift;
|
||||
my $urlobj = url $url;
|
||||
$url = $urlobj->as_string;
|
||||
undef $urlobj;
|
||||
return $url;
|
||||
}
|
||||
|
||||
sub __is_picture($) {
|
||||
my $url = shift;
|
||||
$url = __urlencode($url);
|
||||
my $r = undef;
|
||||
|
||||
eval {
|
||||
my $http = HTTP::Tiny->new();
|
||||
$r = $http->request('HEAD', $url);
|
||||
undef $http;
|
||||
};
|
||||
|
||||
if ($r->{'success'} and defined($r->{'headers'}->{'content-type'})) {
|
||||
if ($r->{'headers'}->{'content-type'} =~ /^image\/gif/) { $r = 'gif'; }
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^image\/jpe?g/){ $r = 'jpeg';}
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^image\/png/) { $r = 'png'; }
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^video\/webm/) { $r = 'webm';}
|
||||
elsif ($r->{'headers'}->{'content-type'} =~ /^video\/mp4/) { $r = 'mp4'; }
|
||||
else { $r = undef; }
|
||||
} else {
|
||||
$r = undef;
|
||||
}
|
||||
|
||||
undef $url;
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub __dlfunc(@) {
|
||||
my $url = shift;
|
||||
my $file = shift;
|
||||
$url = __urlencode($url);
|
||||
|
||||
eval {
|
||||
my $http1 = HTTP::Tiny->new();
|
||||
$http1->mirror($url, $file);
|
||||
undef $http1;
|
||||
};
|
||||
|
||||
eval {
|
||||
if ($file =~ /(png|jpe?g|gif)$/i) {
|
||||
my $im = Image::Magick->new();
|
||||
my $rename = 1;
|
||||
my (undef, undef, undef, $format) = $im->Ping($file);
|
||||
|
||||
if (defined($format)) {
|
||||
$rename = 0 if (($format eq 'JPEG') and ($file =~ /jpe?g$/i));
|
||||
$rename = 0 if (($format eq 'GIF') and ($file =~ /gif$/i));
|
||||
$rename = 0 if (($format =~ /^PNG/) and ($file =~ /png$/i));
|
||||
rename $file, sprintf("%s.%s", $file, lc($format)) if ($rename == 1);
|
||||
}
|
||||
|
||||
undef $im;
|
||||
undef $rename;
|
||||
undef $format;
|
||||
}
|
||||
}
|
||||
|
||||
#undef $url;
|
||||
#undef $file;
|
||||
#return;
|
||||
}
|
||||
|
||||
|
||||
sub dl_thread (@) {
|
||||
my $dir = shift;
|
||||
my $sleep = shift;
|
||||
threads->detach();
|
||||
|
||||
while ( 1 ) {
|
||||
if (@{main::images} > 0) {
|
||||
my @pic = @{main::images};
|
||||
@{main::images} = -1;
|
||||
|
||||
foreach my $url (@pic) {
|
||||
my $extension = __is_picture($url);
|
||||
|
||||
if (defined($extension)) {
|
||||
my $savepath = $dir;
|
||||
mkdir ($savepath) unless (-d $savepath);
|
||||
my $fname = $url;
|
||||
$fname =~ s/[^\w!., -#]/_/g;
|
||||
$savepath = sprintf("%s/%s.%s", $savepath, $fname, $extension);
|
||||
|
||||
if ( (lc($url) =~ /\.(gif|jpe?g|png|webm|mp4)$/) and ($1 eq $extension) ) {
|
||||
$savepath = $dir . "/" . $fname;
|
||||
}
|
||||
|
||||
__dlfunc($url, $savepath);
|
||||
undef $savepath;
|
||||
undef $fname;
|
||||
}
|
||||
|
||||
undef $url;
|
||||
undef $extension;
|
||||
}
|
||||
@pic = -1; undef @pic;
|
||||
} else {
|
||||
sleep ($sleep);
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
30
lib/paste.pm
Normal file
30
lib/paste.pm
Normal file
@@ -0,0 +1,30 @@
|
||||
package paste;
|
||||
|
||||
use strict;
|
||||
use vars qw/$VERSION/;
|
||||
|
||||
$VERSION = "1.0";
|
||||
|
||||
sub shorten {
|
||||
if (defined($env{HTTP_LINK}) {
|
||||
|
||||
} else {
|
||||
if (defined($env{'QUERY_STRING'}) && $env{'QUERY_STRING'} < 8) {
|
||||
unless (open (L, "data/links.txt")) {
|
||||
return('500', 'text/plain', "Bad permission\n");
|
||||
}
|
||||
|
||||
while (my $str = <L>) {
|
||||
|
||||
}
|
||||
|
||||
return('302', 'text/plain', "$link\n");
|
||||
} else {
|
||||
return ('200', 'text/plain', "What?\n");
|
||||
}
|
||||
}
|
||||
|
||||
return ('200', 'text/plain', "$msg\n");
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -3,6 +3,9 @@ package ping;
|
||||
use strict;
|
||||
use vars qw/$VERSION/;
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT = qw(pong);
|
||||
|
||||
$VERSION = "1.0";
|
||||
|
||||
sub pong {
|
||||
|
||||
@@ -4,9 +4,12 @@ use strict;
|
||||
use Socket; # for name resolves
|
||||
use Net::LibIDN ':all';
|
||||
use vars qw/$VERSION/;
|
||||
|
||||
$VERSION = "1.0";
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT = qw(ip getaddrbyname getnamebyaddr pubycoder punydecoder mytime);
|
||||
|
||||
|
||||
sub ip ($) {
|
||||
my $env = shift;
|
||||
my $msg = '';
|
||||
|
||||
38
myapi.psgi
38
myapi.psgi
@@ -10,6 +10,7 @@ use lib "./lib";
|
||||
use ping;
|
||||
use utils;
|
||||
use easter_egg;
|
||||
use image_dl;
|
||||
|
||||
sub loadConf();
|
||||
sub saveConf($);
|
||||
@@ -17,13 +18,17 @@ sub saveConf($);
|
||||
sub mythread();
|
||||
|
||||
my $main :shared = 0;
|
||||
|
||||
#unless ($main) { threads->create('mythread'); }
|
||||
our @images :shared;
|
||||
|
||||
my $CONF = loadConf();
|
||||
|
||||
if ($CONF->{api}->{prefix} eq '/') { $CONF->{api}->{prefix} = ''; }
|
||||
my $prefix = $CONF->{api}->{prefix};
|
||||
|
||||
#unless ($main) { threads->create('__dl_thread'); }
|
||||
threads->create('dl_thread', $CONF->{image_dl}->{dir}, $CONF->{image_dl}->{sleep});
|
||||
threads->create('mythread');
|
||||
|
||||
my $app = sub {
|
||||
my $env = shift;
|
||||
|
||||
@@ -48,34 +53,36 @@ EOL
|
||||
$status = '200';
|
||||
$msg = Dumper($env);
|
||||
} elsif ($env->{PATH_INFO} eq "$prefix/ping") {
|
||||
($status, $content, $msg) = ping::pong();
|
||||
($status, $content, $msg) = pong();
|
||||
} elsif ($env->{PATH_INFO} eq "$prefix/ip") {
|
||||
($status, $content, $msg) = utils::ip($env);
|
||||
($status, $content, $msg) = ip($env);
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/getaddrbyname")) {
|
||||
($status, $content, $msg) = utils::getaddrbyname($env->{HTTP_HOSTNAME});
|
||||
($status, $content, $msg) = getaddrbyname($env->{HTTP_HOSTNAME});
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/getnamebyaddr")) {
|
||||
($status, $content, $msg) = utils::getnamebyaddr($env->{HTTP_ADDRESS});
|
||||
($status, $content, $msg) = getnamebyaddr($env->{HTTP_ADDRESS});
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/punycoder")) {
|
||||
($status, $content, $msg) = utils::punycoder($env->{HTTP_HOSTNAME});
|
||||
($status, $content, $msg) = punycoder($env->{HTTP_HOSTNAME});
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/punydecoder")) {
|
||||
($status, $content, $msg) = utils::punydecoder($env->{HTTP_HOSTNAME});
|
||||
($status, $content, $msg) = punydecoder($env->{HTTP_HOSTNAME});
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/time")) {
|
||||
($status, $content, $msg) = utils::mytime();
|
||||
($status, $content, $msg) = mytime();
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/fortune") or
|
||||
($env->{PATH_INFO} eq "$prefix/quote")) {
|
||||
($status, $content, $msg) = easter_egg::quote();
|
||||
($status, $content, $msg) = quote();
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/chanserv") or
|
||||
($env->{PATH_INFO} eq "$prefix/chanServ") or
|
||||
($env->{PATH_INFO} eq "$prefix/ChanServ") or
|
||||
($env->{PATH_INFO} eq "$prefix/CHANSERV")) {
|
||||
($status, $content, $msg) = easter_egg::chanserv();
|
||||
($status, $content, $msg) = chanserv();
|
||||
} elsif (($env->{PATH_INFO} eq "$prefix/nickserv") or
|
||||
($env->{PATH_INFO} eq "$prefix/nickServ") or
|
||||
($env->{PATH_INFO} eq "$prefix/NickServ") or
|
||||
($env->{PATH_INFO} eq "$prefix/NICKSERV")) {
|
||||
($status, $content, $msg) = easter_egg::nickserv();
|
||||
($status, $content, $msg) = nickserv();
|
||||
} elsif ($env->{PATH_INFO} eq "$prefix/me") {
|
||||
($status, $content, $msg) = easter_egg::me();
|
||||
($status, $content, $msg) = me();
|
||||
} elsif ($env->{PATH_INFO} eq "$prefix/image") {
|
||||
($status, $content, $msg) = queue_image($env->{HTTP_LINK}, \@images);
|
||||
}
|
||||
|
||||
return [
|
||||
@@ -111,9 +118,10 @@ sub mythread () {
|
||||
threads->detach();
|
||||
|
||||
while (1) {
|
||||
sleep 1;
|
||||
sleep 10;
|
||||
push(@images, 'http://192.168.88.1/help.png');
|
||||
open (F, ">>", '/tmp/myapi.txt');
|
||||
print F time() . "\n";
|
||||
print F time() . " " . join(', ', @images) . "\n";
|
||||
close F;
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user