* Plugins related to image downloding moved to subdir
+ Added plugin with sample dowloader that stores and retrieves links to/from memcache
This commit is contained in:
eleksir
179
web_link_saver/img-save.pl
Normal file
179
web_link_saver/img-save.pl
Normal file
@@ -0,0 +1,179 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
use warnings "all";
|
||||
use strict;
|
||||
use Cache::Memcached;
|
||||
use URI::URL;
|
||||
my $HTINY = undef;
|
||||
my $HTINYS = undef;
|
||||
$HTINY = eval {
|
||||
require HTTP::Tiny; # stock perl module, but some assholes from debian rip perl into modules,
|
||||
import HTTP::Tiny; # so there is non-zero possibility that we have no this module
|
||||
$HTINYS = HTTP::Tiny->can_ssl; # to operate ssl stuff, we need Net::SSLeay, but sometimes
|
||||
return 1; # installed perl environment lacks it, so use Tiny with care
|
||||
};
|
||||
|
||||
my $IMAGEMAGICK = undef; # use on demand
|
||||
if ($^O ne 'cygwin') { # cygwin 2.882 64-bit has broken Image::Magick
|
||||
$IMAGEMAGICK = eval {
|
||||
require Image::Magick;
|
||||
import Image::Magick qw(ping);
|
||||
return 1;
|
||||
};
|
||||
}
|
||||
|
||||
sub dlfunc(@);
|
||||
sub cdlfunc($); # thread, that checks and downloads stuff
|
||||
sub is_picture($);
|
||||
sub urlencode($);
|
||||
|
||||
my $wgetpath = '';
|
||||
|
||||
if (-f "/bin/wget") {
|
||||
$wgetpath = '/bin/wget';
|
||||
} elsif (-f "/usr/bin/wget") {
|
||||
$wgetpath = '/usr/bin/wget';
|
||||
} elsif (-f "/usr/local/bin/wget") {
|
||||
$wgetpath = '/usr/local/bin/wget';
|
||||
}
|
||||
|
||||
while ( 1 ) {
|
||||
my $memd = new Cache::Memcached { 'servers' => [ "127.0.0.1:11211" ] };
|
||||
my $itemref = $memd->stats(['items']);
|
||||
|
||||
if (length($itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}) > 2) {
|
||||
my $slabinfo = (split("\n", $itemref->{'hosts'}->{'127.0.0.1:11211'}->{'items'}))[0];
|
||||
my $slab = (split(/\:/, $slabinfo))[1];
|
||||
my $itemsamount = (split(/ /, $slabinfo))[2];
|
||||
my $cachedump = $memd->stats(["cachedump $slab $itemsamount"]);
|
||||
my @keys = map { (split(/ /))[1] } split(/\n/, $cachedump->{'hosts'}->{'127.0.0.1:11211'}->{"cachedump $slab $itemsamount"});
|
||||
|
||||
foreach my $key (@keys) {
|
||||
my $url = $memd->get($key);
|
||||
cdlfunc($url);
|
||||
$memd->delete($key);
|
||||
}
|
||||
}
|
||||
|
||||
$memd->disconnect_all;
|
||||
sleep(30);
|
||||
}
|
||||
|
||||
|
||||
sub cdlfunc($) {
|
||||
my $url = shift;
|
||||
my $extension = is_picture($url);
|
||||
|
||||
if (defined($extension)) {
|
||||
my $savepath = sprintf("%s/imgsave", $ENV{'HOME'});
|
||||
mkdir ($savepath) unless (-d $savepath);
|
||||
my $fname = $url;
|
||||
$fname =~ s/[^\w!., -#]/_/g;
|
||||
$savepath = $savepath . "/" . $fname . ".$extension";
|
||||
|
||||
if ( (lc($url) =~ /\.(gif|jpeg|png|webm|mp4)$/) and ($1 eq $extension) ){
|
||||
$savepath = $ENV{'HOME'} . "/imgsave/" . $fname;
|
||||
}
|
||||
|
||||
dlfunc($url, $savepath);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub dlfunc(@) {
|
||||
my $url = shift;
|
||||
my $file = shift;
|
||||
$url = urlencode($url);
|
||||
|
||||
if (($url =~ /^https/) and defined($HTINY) and ($HTINYS)) {
|
||||
eval {
|
||||
my $http1 = HTTP::Tiny->new();
|
||||
$http1->mirror($url, $file);
|
||||
undef $http1;
|
||||
};
|
||||
} elsif (defined($HTINY)) {
|
||||
eval {
|
||||
my $http2 = HTTP::Tiny->new();
|
||||
$http2->mirror($url, $file);
|
||||
undef $http2;
|
||||
};
|
||||
} else {
|
||||
system($wgetpath, '--no-check-certificate', '-q', '-T', '20', '-O', $file, '-o', '/dev/null', $url);
|
||||
}
|
||||
|
||||
if (($^O ne 'cygwin') and defined($IMAGEMAGICK)) {
|
||||
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);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub is_picture($) {
|
||||
my $url = shift;
|
||||
$url = urlencode($url);
|
||||
my $r = undef;
|
||||
|
||||
if (($url =~ /^https/) and defined($HTINY) and ($HTINYS)) {
|
||||
eval {
|
||||
my $http = HTTP::Tiny->new();
|
||||
$r = $http->request('HEAD', $url);
|
||||
undef $url;
|
||||
undef $http;
|
||||
};
|
||||
} elsif (defined($HTINY)) {
|
||||
eval {
|
||||
my $http = HTTP::Tiny->new();
|
||||
$r = $http->request('HEAD', $url);
|
||||
undef $url;
|
||||
undef $http;
|
||||
};
|
||||
} else {
|
||||
$r = `$wgetpath --no-check-certificate -q --method=HEAD -S --timeout=5 "$url" 2>&1`;
|
||||
if ($? == 0) {
|
||||
foreach (split(/\n/, $r)) {
|
||||
next unless($_ =~ /Content\-Type: (.+)/);
|
||||
my $h = ($1); chomp($h);
|
||||
$r->{'success'} = 1;
|
||||
$r->{'headers'}->{'content-type'} = $h;
|
||||
last;
|
||||
}
|
||||
} else {
|
||||
$r->{'success'} = 0;
|
||||
}
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub urlencode($) {
|
||||
my $url = shift;
|
||||
my $urlobj = url $url;
|
||||
$url = $urlobj->as_string;
|
||||
undef $urlobj;
|
||||
return $url;
|
||||
}
|
||||
297
web_link_saver/img_url_memc.pl
Normal file
297
web_link_saver/img_url_memc.pl
Normal file
@@ -0,0 +1,297 @@
|
||||
use HexChat qw(:all);
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
use Socket; # hexchat in windows does not ship proper memcache interface, so we will
|
||||
# use Socket module and memcache text protocol
|
||||
use Digest::MD5 qw(md5_base64);
|
||||
|
||||
sub hookfn;
|
||||
sub loadliststatus($);
|
||||
sub loadlist($);
|
||||
sub savelist(@);
|
||||
sub savesetting(@);
|
||||
sub freehooks;
|
||||
|
||||
my $script_name = "URL_Memcacher";
|
||||
HexChat::register($script_name, '0.3', 'Automatically stores URLs to Memcache', \&freehooks);
|
||||
|
||||
HexChat::print("$script_name loaded\n");
|
||||
my $help = 'Usage:
|
||||
/dl enable nick|domain <name> - enable nick or domain blacklist
|
||||
/dl disable nick|domain <name> - disable nick or domain blacklist
|
||||
/dl add nick|domain <name> - adds nick or domain to apropriate blacklist
|
||||
/dl del nick|domain <name> - removes nick or domain from apropriate blacklist
|
||||
/dl show - show blacklists
|
||||
/dl info - same as above
|
||||
';
|
||||
my @hooks;
|
||||
push @hooks, HexChat::hook_print('Channel Message', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Msg Hilight', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Action', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Action Hilight', \&hookfn);
|
||||
push @hooks, HexChat::hook_command('dl', \&dl_cmd);
|
||||
|
||||
my $host="localhost";
|
||||
my $port="11211";
|
||||
|
||||
|
||||
sub hookfn {
|
||||
my ($nick, $text, $modechar) = @{$_[0]};
|
||||
my $nicklist = loadliststatus('dl_nicklist');
|
||||
|
||||
if ($nicklist != 0) {
|
||||
my @nicklist = loadlist('dl_nicks');
|
||||
|
||||
foreach (@nicklist) {
|
||||
next unless(defined($_));
|
||||
next if($_ eq '');
|
||||
|
||||
if ($_ eq $nick) {
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
undef $nicklist;
|
||||
@nicklist = -1; undef @nicklist;
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
@nicklist = -1; undef @nicklist;
|
||||
}
|
||||
|
||||
undef $nicklist;
|
||||
|
||||
my @words = split(/\s+/, $text);
|
||||
|
||||
foreach (@words) {
|
||||
my $str = $_;
|
||||
next unless(substr($str, 0, 4) eq 'http');
|
||||
|
||||
if ($str =~ m{https?://([a-zA-Z0-9.-]+\.[a-zA-Z]+)/(?:.*)}) {
|
||||
my $domain = $1;
|
||||
my $domainlist = loadliststatus('dl_domainlist');
|
||||
|
||||
if ($domainlist != 0) {
|
||||
my @domainlist = loadlist('dl_domains');
|
||||
|
||||
foreach (@domainlist) {
|
||||
next unless(defined($_));
|
||||
next if($_ eq '');
|
||||
|
||||
if ($_ eq $domain) {
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
@words = -1; undef @words;
|
||||
undef $str; undef $domain;
|
||||
undef $domainlist;
|
||||
@domainlist = -1; undef @domainlist;
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
@domainlist = -1, undef @domainlist;
|
||||
}
|
||||
|
||||
undef $domainlist;
|
||||
|
||||
if (socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'))) {
|
||||
my $iaddr = inet_aton($host);
|
||||
my $paddr = sockaddr_in($port, $iaddr);
|
||||
|
||||
if (connect(SOCK, $paddr)) {
|
||||
send (SOCK, sprintf("set %s 0 0 %s noreply\r\n%s\r\nquit\r\n", md5_base64($str), length($str), $str), 0);
|
||||
}
|
||||
|
||||
close(SOCK);
|
||||
undef $iaddr; undef $paddr;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@words = -1; undef @words;
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
|
||||
sub loadliststatus($){
|
||||
my $listtype = shift;
|
||||
my $list = HexChat::plugin_pref_get($listtype);
|
||||
|
||||
unless (defined($list)) {
|
||||
savesetting('list', '0');
|
||||
$list = 0;
|
||||
}
|
||||
|
||||
undef $listtype;
|
||||
return $list;
|
||||
}
|
||||
|
||||
sub loadlist($){
|
||||
my $setting = shift;
|
||||
my $val = HexChat::plugin_pref_get($setting);
|
||||
|
||||
unless (defined($val)) {
|
||||
savesetting($setting, encode_base64('', ''));
|
||||
$val = '';
|
||||
}
|
||||
|
||||
my @values = map { decode_base64($_); } split(/ /, $val);
|
||||
undef $setting; undef $val;
|
||||
return @values;
|
||||
}
|
||||
|
||||
sub savelist(@) {
|
||||
my $setting = shift;
|
||||
my @list = map { encode_base64($_, ''); } @_;
|
||||
my $value = join(' ', @list);
|
||||
@list = -1; undef @list;
|
||||
return savesetting($setting, $value);
|
||||
}
|
||||
|
||||
sub savesetting(@) {
|
||||
my $setting = shift;
|
||||
my $value = shift;
|
||||
|
||||
if (HexChat::plugin_pref_set($setting, $value) == 0) {
|
||||
HexChat::printf("Unable to save settings for %s\n", $script_name);
|
||||
undef $setting; undef $value;
|
||||
return undef;
|
||||
}
|
||||
|
||||
undef $setting;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub dl_cmd {
|
||||
shift(@{$_[0]});
|
||||
my $cmd = shift(@{$_[0]});
|
||||
my $entity = shift(@{$_[0]});
|
||||
my $value = join(' ', @{$_[0]});
|
||||
HexChat::print("\n");
|
||||
my $msg = undef;
|
||||
|
||||
if (defined($cmd)) {
|
||||
if ($cmd eq 'enable') {
|
||||
if($entity eq 'nick') {
|
||||
if (defined(savesetting('dl_nicklist', '1'))) {
|
||||
$msg = "Nicks blacklist now enabled\n";
|
||||
}
|
||||
} elsif ($entity eq 'domain') {
|
||||
if (defined(savesetting('dl_domainlist', '1'))) {
|
||||
$msg = "Domains blacklist now enabled\n";
|
||||
}
|
||||
}
|
||||
} elsif ($cmd eq 'disable') {
|
||||
if($entity eq 'nick') {
|
||||
if (defined(savesetting('dl_nicklist', '0'))) {
|
||||
$msg = "Nicks blacklist now disabled\n";
|
||||
}
|
||||
} elsif ($entity eq 'domain') {
|
||||
if (defined(savesetting('dl_domainlist', '0'))) {
|
||||
$msg = "Domains blacklist now disabled\n";
|
||||
}
|
||||
}
|
||||
} elsif (($cmd eq 'show') or ($cmd eq 'info')) {
|
||||
$msg = '';
|
||||
|
||||
if (loadliststatus('dl_nicklist') == 0) {
|
||||
$msg .= "Nicks blacklist: disabled\n";
|
||||
} else {
|
||||
$msg .= "Nicks blacklist: enabled\n";
|
||||
}
|
||||
|
||||
$msg .= "Blacklisted nicks = " . join( ', ', loadlist('dl_nicks')) ."\n";
|
||||
|
||||
if (loadliststatus('dl_domainlist') == 0) {
|
||||
$msg .= "Domains blacklist: disabled\n";
|
||||
} else {
|
||||
$msg .= "Domains blacklist: enabled\n";
|
||||
}
|
||||
|
||||
$msg .= "Blacklisted domains = " . join( ', ', loadlist('dl_domains')) . "\n";
|
||||
} elsif ($cmd eq 'add') {
|
||||
if ((defined($entity)) and (defined($value))) {
|
||||
if ($entity eq 'nick') {
|
||||
my @nicks = (loadlist('dl_nicks'), $value);
|
||||
|
||||
unless (defined(savelist('dl_nicks', @nicks))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@nicks = -1; undef @nicks;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Nicks blacklist now: %s\n", join(', ', @nicks));
|
||||
@nicks = -1; undef @nicks;
|
||||
} elsif ($entity eq 'domain') {
|
||||
my @domains = (loadlist('dl_domains'), $value);
|
||||
|
||||
unless (defined(savelist('dl_domains', @domains))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@domains = -1; undef @domains;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Domains blacklist now: %s\n", join(', ', @domains));
|
||||
@domains = -1; undef @domains;
|
||||
}
|
||||
}
|
||||
} elsif ($cmd eq 'del') {
|
||||
if ((defined($entity)) and (defined($value))) {
|
||||
if ($entity eq 'nick') {
|
||||
my @list = loadlist('dl_nicks');
|
||||
my @nicklist;
|
||||
|
||||
foreach (@list) {
|
||||
next if ($_ eq $value);
|
||||
push @nicklist, $_;
|
||||
}
|
||||
|
||||
@list = -1; undef @list;
|
||||
|
||||
unless (defined(savelist('dl_nicks', @nicklist))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@nicklist = -1; undef @nicklist;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Nicks blacklist now: %s\n", join(', ', @nicklist));
|
||||
@nicklist = -1; undef @nicklist;
|
||||
} elsif ($entity eq 'domain') {
|
||||
my @list = loadlist('dl_domains');
|
||||
my @domainlist;
|
||||
|
||||
foreach (@list) {
|
||||
next if ($_ eq $value);
|
||||
push @domainlist, $_;
|
||||
}
|
||||
|
||||
@list = -1; undef @list;
|
||||
|
||||
unless (defined(savelist('dl_domains', @domainlist))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@domainlist = -1; undef @domainlist;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Domains blacklist now: %s\n", join(', ', @domainlist));
|
||||
@domainlist = -1; undef @domainlist;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
unless(defined($msg)) {
|
||||
HexChat::print($help);
|
||||
} else {
|
||||
HexChat::print($msg);
|
||||
}
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
sub freehooks {
|
||||
foreach (@hooks) {
|
||||
HexChat::unhook($_);
|
||||
}
|
||||
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
4
web_link_saver/readme.md
Normal file
4
web_link_saver/readme.md
Normal file
@@ -0,0 +1,4 @@
|
||||
Plugins in unsafe dir relies on perl threads which are unsafe in Hexchat (well, at least until 2.12.4 including) because of general thread unsafeness of hexchat internal api. Scripts are working correctly and the only side-effect that occurs - notable memory leak. Looks like threads never release consumed memory.
|
||||
|
||||
As a workaround img_url_memc.pl uses external key-value database to store links. Sample image download client (img-save.pl) included to provide working solution.
|
||||
|
||||
271
web_link_saver/unsafe/img_url_grab_dl.pl
Normal file
271
web_link_saver/unsafe/img_url_grab_dl.pl
Normal file
@@ -0,0 +1,271 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
# WARNING: this script is Proof of Concept and contains incorrect logic
|
||||
# it placed here only for historical reasons
|
||||
|
||||
# HexChat Perl script
|
||||
# Automatically save images that are linked in a channel to [hexchat-dir]/imgsave on linux/unices or %USERPROFILE%\Downloads on Windows
|
||||
# You may need to create this directory first
|
||||
# The bad_domains array may be used to exclude image URLs with domains matching any of a list of patterns. Set to an empty list to disable.
|
||||
# Written by Jonathan Rennison (j.g.rennison@gmail.com)
|
||||
# 2012-02-18
|
||||
# Loosely based on http://pastebin.com/QE24QJ8p by Derek Meister
|
||||
# 2016-05-02
|
||||
# coding style fixes, port to windows/activeperl, add failover to some different download modules make WWW::Curl default method, as it thread safe and more robust than LWP
|
||||
# 2016-05-15
|
||||
# coding style fixes, added content guessing for links that does not contain file extension, not for all backends (powershell is missing), WWW::Curl is dropped due to many troubles with symbols loading
|
||||
|
||||
# TODO: enhance urlencode with punicode
|
||||
# TODO: refuse HTTP::Tiny for ipv6-only host (due to lack of ipv4 suppoort in this module)
|
||||
# TODO: looks like we definely need dns resolver here to to guess ipv6-only hosts
|
||||
# TODO: suppress any errors (errors only in debug mode)
|
||||
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
|
||||
use threads;
|
||||
use URI::URL;
|
||||
|
||||
# standard way (looks like this module should be in perl package, unless it is split-package)
|
||||
my $got_HTTP_Tiny = 0;
|
||||
eval { require HTTP::Tiny };
|
||||
|
||||
unless ($@) {
|
||||
$got_HTTP_Tiny = 1;
|
||||
HTTP::Tiny->import();
|
||||
}
|
||||
|
||||
# fat way
|
||||
my $got_LWP_Simple = 0;
|
||||
my $got_wget = 0;
|
||||
my $got_curl = 0;
|
||||
my $curlpath;
|
||||
my $wgetpath;
|
||||
my $got_powershell = 0;
|
||||
|
||||
if ($got_HTTP_Tiny == 0) {
|
||||
eval { require LWP::Simple };
|
||||
|
||||
unless ($@) {
|
||||
$got_LWP_Simple = 1;
|
||||
LWP::Simple->import();
|
||||
} else {
|
||||
|
||||
# failover way
|
||||
if (-f "/bin/wget") {
|
||||
$got_wget = 1;
|
||||
$wgetpath = '/bin/wget';
|
||||
} elsif (-f "/usr/bin/wget") {
|
||||
$got_wget = 1;
|
||||
$wgetpath = '/usr/bin/wget';
|
||||
} elsif (-f "/usr/local/bin/wget") {
|
||||
$got_wget = 1;
|
||||
$wgetpath = '/usr/local/bin/wget';
|
||||
}
|
||||
|
||||
if (-f "/bin/curl") {
|
||||
$got_curl = 1;
|
||||
$curlpath = '/bin/curl';
|
||||
} elsif (-f "/usr/bin/curl") {
|
||||
$got_curl = 1;
|
||||
$curlpath = '/usr/bin/curl';
|
||||
} elsif (-f "/usr/local/bin/curl") {
|
||||
$got_curl = 1;
|
||||
$curlpath = '/usr/local/bin/curl';
|
||||
}
|
||||
|
||||
if ($^O eq 'MSWin') {
|
||||
$got_powershell = 1;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
sub hookfn; # in defaults we trust: dunno arrayname/args name, but default values looks good :)
|
||||
sub dlfunc(@); # download thread
|
||||
sub cdlfunc(@); # thread, that checks and downloads stuff
|
||||
sub is_picture($); # sub thar checks the mime-type
|
||||
sub urlencode($); # correctly encode url :)
|
||||
|
||||
my $script_name = "Image URL Auto Grabber and Downloader";
|
||||
HexChat::register($script_name, '0.6-alpha1', 'Automatically grabs and downloads image URLs');
|
||||
|
||||
HexChat::print("$script_name loaded\n");
|
||||
HexChat::hook_print('Channel Message', \&hookfn);
|
||||
HexChat::hook_print('Channel Msg Hilight', \&hookfn);
|
||||
HexChat::hook_print('Channel Action', \&hookfn);
|
||||
HexChat::hook_print('Channel Action Hilight', \&hookfn);
|
||||
|
||||
my @bad_domains = (); #array of regexs for domain name exclusion
|
||||
#my @bad_domains = (qr/^(?:.*\.)?example\.com$/, qr/\bbannedword\b/, qr/^name\./); #example, exclude: example.com and subdomains, domains containing the term bannedword, and domains starting with name.
|
||||
|
||||
sub hookfn {
|
||||
my ($nick, $text, $modechar) = @{$_[0]};
|
||||
my @words = split(/\s+/, $text);
|
||||
|
||||
foreach (@words) {
|
||||
# here we try to catch string that can contain http or https at beginning (assume http if none)
|
||||
# and after all ends with known extension
|
||||
if ($_ =~ m{^(?:https?://)?([a-zA-Z0-9.-]+\.[a-zA-Z]+)/(?:.*)\.(?:jpe?g|png|gif|mp4|webm)$}i) {
|
||||
|
||||
foreach my $re (@bad_domains) {
|
||||
return HexChat::EAT_NONE if ($1 =~ $re);
|
||||
}
|
||||
|
||||
# reconstruct url if it does not contain proto schema
|
||||
if ( $_ !~ m{^https?://} ) {
|
||||
$_="http://".$_;
|
||||
}
|
||||
# create filename
|
||||
my $fn;
|
||||
|
||||
if ( $^O eq 'MSWin32' ) {
|
||||
$fn = $ENV{USERPROFILE} . "\\Downloads\\" . s/[^\w!., -#]/_/gr;
|
||||
} else {
|
||||
|
||||
unless (-d sprintf("%s/imgsave", HexChat::get_info("configdir"))) {
|
||||
mkdir (sprintf("%s/imgsave", HexChat::get_info("configdir")));
|
||||
}
|
||||
|
||||
$fn = HexChat::get_info("configdir") . "/imgsave/" . s/[^\w!., -#]/_/gr;
|
||||
}
|
||||
|
||||
if ($got_HTTP_Tiny == 1) {
|
||||
my $th = threads->create(\&dlfunc, $_, $fn);
|
||||
$th->detach();
|
||||
} elsif ($got_LWP_Simple == 1) {
|
||||
|
||||
if($_ =~ m{^https://}) {
|
||||
LWP::Simple::mirror($_, $fn); # LWP SSL is not thread safe
|
||||
} else {
|
||||
my $th = threads->create(\&dlfunc, $_, $fn);
|
||||
$th->detach();
|
||||
}
|
||||
|
||||
} else {
|
||||
my $th = threads->create(\&dlfunc, $_, $fn);
|
||||
$th->detach();
|
||||
}
|
||||
|
||||
} elsif ($_ =~ m{https?://([a-zA-Z0-9.-]+\.[a-zA-Z]+)/(?:.*)}) {
|
||||
# here we try to download _url_ that begins with https and does not ends with known file type
|
||||
my $full_url = $_;
|
||||
my $fqdn = $1;
|
||||
my $uri_part = $2;
|
||||
|
||||
if ($got_HTTP_Tiny == 1) {
|
||||
my $thr = threads->create(\&cdlfunc, $full_url);
|
||||
$thr->detach();
|
||||
} elsif ($got_LWP_Simple == 1) {
|
||||
|
||||
if ($full_url =~ m{^https://}) {
|
||||
cdlfunc($full_url);
|
||||
} else {
|
||||
my $thr = threads->create(\&cdlfunc, $full_url);
|
||||
$thr->detach();
|
||||
}
|
||||
|
||||
} else {
|
||||
my $thr = threads->create(\&cdlfunc, $full_url);
|
||||
$thr->detach();
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
|
||||
sub dlfunc(@) {
|
||||
my $file = shift; # 0
|
||||
my $url = shift; # 1
|
||||
$url = urlencode($url);
|
||||
|
||||
if ($got_HTTP_Tiny == 1) {
|
||||
my $http = HTTP::Tiny->new();
|
||||
$http->mirror($file, $url);
|
||||
undef $http;
|
||||
} elsif ($got_LWP_Simple == 1) {
|
||||
LWP::Simple::mirror($file, $url);
|
||||
} elsif ($got_wget == 1) {
|
||||
`$wgetpath -q -T 20 -O '$file' '$url'`;
|
||||
} elsif ($got_curl == 1) {
|
||||
`$curlpath -k -L -m 20 -o '$file' '$url'`;
|
||||
} elsif ($got_powershell == 1) {
|
||||
`powershell -command "& { (New-Object Net.WebClient).DownloadFile('$file', '$url') }"`;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub cdlfunc(@) {
|
||||
my $url = shift;
|
||||
my $extension = is_picture($url);
|
||||
|
||||
if (defined($extension)) {
|
||||
my $fname;
|
||||
|
||||
if ( $^O eq 'MSWin32' ) {
|
||||
$fname = $ENV{USERPROFILE} . "\\Downloads\\" . s/[^\w!., -#]/_/gr . ".$extension";
|
||||
} else {
|
||||
|
||||
unless (-d sprintf("%s/imgsave", HexChat::get_info("configdir"))) {
|
||||
mkdir (sprintf("%s/imgsave", HexChat::get_info("configdir")));
|
||||
}
|
||||
|
||||
$fname = HexChat::get_info("configdir") . "/imgsave/" . s/[^\w!., -#]/_/gr . ".$extension";
|
||||
}
|
||||
|
||||
dlfunc($url, $fname);
|
||||
}
|
||||
}
|
||||
|
||||
sub is_picture($) {
|
||||
my $url = shift;
|
||||
$url = urlencode($url);
|
||||
my $r = undef;
|
||||
|
||||
if ($got_HTTP_Tiny == 1) {
|
||||
my $response = HTTP::Tiny->new->head($url);
|
||||
$r = ${$response->{headers}}{'content-type'};
|
||||
} elsif ($got_LWP_Simple == 1) {
|
||||
$r = (LWP::Simple::head($url))[0];
|
||||
} elsif ($got_wget == 1) {
|
||||
$r = `$wgetpath --no-check-certificate -q --method=HEAD -S --timeout=15 "$url" 2>&1`;
|
||||
|
||||
foreach (split(/\n/, $r)) {
|
||||
next unless($_ =~ /Content\-Type: (.+)/);
|
||||
$r = ($1); chomp($r);
|
||||
last;
|
||||
}
|
||||
|
||||
} elsif ($got_curl == 1) {
|
||||
$r = `$curlpath -I -k -f -s -m 15 "$url"`;
|
||||
|
||||
foreach (split(/\n/, $r)) {
|
||||
next unless($_ =~ /Content\-Type: (.+)/);
|
||||
$r = ($1); chomp($r);
|
||||
last;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if (defined($r)) {
|
||||
if ($r =~ /^image\/gif/) {return 'gif';};
|
||||
if ($r =~ /^image\/jpe?g/){return 'jpeg';};
|
||||
if ($r =~ /^image\/png/) {return 'png';};
|
||||
if ($r =~ /^video\/webm/) {return 'webm';};
|
||||
if ($r =~ /^video\/mp4/) {return 'mp4';};
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub urlencode($) {
|
||||
my $url = shift;
|
||||
my $urlobj = url $url;
|
||||
$url = $urlobj->as_string;
|
||||
undef $urlobj;
|
||||
return $url;
|
||||
}
|
||||
|
||||
__END__
|
||||
404
web_link_saver/unsafe/img_url_tiny.pl
Normal file
404
web_link_saver/unsafe/img_url_tiny.pl
Normal file
@@ -0,0 +1,404 @@
|
||||
# one of hexchat contributors said this on freenode's #hexchat
|
||||
# 2017-11-26 15:36 < TingPing> eleksir, the hexchat api isn't thread safe
|
||||
# on practice it developes to memory leak
|
||||
|
||||
use HexChat qw(:all);
|
||||
use threads;
|
||||
use threads::shared;
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
|
||||
use MIME::Base64;
|
||||
use URI::URL;
|
||||
use HTTP::Tiny; # Note that HexChat-2.12.4 bundled perl do not support https via this module, they just miss ssl support at all
|
||||
# activeperl 5.20.* crashes, so do not replace bundled perl with activeperl
|
||||
my $IMAGEMAGICK = undef; # use on demand
|
||||
if ($^O ne 'cygwin') { # cygwin 2.882 64-bit hag broken Image::Magick
|
||||
$IMAGEMAGICK = eval {
|
||||
require Image::Magick;
|
||||
import Image::Magick qw(ping);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub dlfunc($); # thread, that checks and downloads stuff
|
||||
sub is_picture($);
|
||||
sub urlencode($);
|
||||
sub hookfn;
|
||||
sub loadliststatus($);
|
||||
sub loadlist($);
|
||||
sub savelist(@);
|
||||
sub savesetting(@);
|
||||
sub dl_cmd;
|
||||
sub freehooks;
|
||||
|
||||
my $wgetpath; share($wgetpath);
|
||||
|
||||
my $script_name = "Image URL Downloader";
|
||||
HexChat::register($script_name, '1.0', 'Automatically downloads image URLs via HTTP::Tiny', \&freehooks);
|
||||
|
||||
HexChat::print("$script_name loaded\n");
|
||||
my $help = 'Usage:
|
||||
/dl enable nick|domain <name> - enable nick or domain blacklist
|
||||
/dl disable nick|domain <name> - disable nick or domain blacklist
|
||||
/dl add nick|domain <name> - adds nick or domain to apropriate blacklist
|
||||
/dl del nick|domain <name> - removes nick or domain from apropriate blacklist
|
||||
/dl show - show blacklists
|
||||
/dl info - same as above
|
||||
';
|
||||
my @hooks;
|
||||
push @hooks, HexChat::hook_print('Channel Message', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Msg Hilight', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Action', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Action Hilight', \&hookfn);
|
||||
push @hooks, HexChat::hook_command('dl', \&dl_cmd);
|
||||
|
||||
my $active = 0;
|
||||
share($active);
|
||||
|
||||
sub hookfn {
|
||||
my ($nick, $text, $modechar) = @{$_[0]};
|
||||
my $nicklist = loadliststatus('dl_nicklist');
|
||||
|
||||
if ($nicklist != 0) {
|
||||
my @nicklist = loadlist('dl_nicks');
|
||||
|
||||
foreach (@nicklist) {
|
||||
next unless(defined($_));
|
||||
next if($_ eq '');
|
||||
|
||||
if ($_ eq $nick) {
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
undef $nicklist;
|
||||
@nicklist = -1; undef @nicklist;
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
@nicklist = -1; undef @nicklist;
|
||||
}
|
||||
|
||||
undef $nicklist;
|
||||
|
||||
my @words = split(/\s+/, $text);
|
||||
|
||||
foreach (@words) {
|
||||
my $str = $_;
|
||||
next unless(substr($str, 0, 4) eq 'http');
|
||||
|
||||
if ($str =~ m{https?://([a-zA-Z0-9.-]+\.[a-zA-Z]+)/(?:.*)}) {
|
||||
my $domain = $1;
|
||||
my $domainlist = loadliststatus('dl_domainlist');
|
||||
|
||||
if ($domainlist != 0) {
|
||||
my @domainlist = loadlist('dl_domains');
|
||||
|
||||
foreach (@domainlist) {
|
||||
next unless(defined($_));
|
||||
next if($_ eq '');
|
||||
|
||||
if ($_ eq $domain) {
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
@words = -1; undef @words;
|
||||
undef $str; undef $domain;
|
||||
undef $domainlist;
|
||||
@domainlist = -1; undef @domainlist;
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
@domainlist = -1, undef @domainlist;
|
||||
}
|
||||
|
||||
undef $domainlist;
|
||||
|
||||
$active = 1;
|
||||
my $t = undef;
|
||||
|
||||
do {
|
||||
$t = threads->create('dlfunc', $str);
|
||||
sleep 1 unless(defined($t));
|
||||
} unless (defined($t));
|
||||
|
||||
$t->detach;
|
||||
undef $t;
|
||||
|
||||
if ($active == 1) {
|
||||
HexChat::hook_timer( 100, sub { return REMOVE if ($active == 0); return KEEP; } );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@words = -1; undef @words;
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
|
||||
sub dlfunc($) {
|
||||
my $url = shift;
|
||||
|
||||
my $extension = is_picture($url);
|
||||
|
||||
if (defined($extension)) {
|
||||
my $savepath = sprintf("%s/imgsave", HexChat::get_info("configdir"));
|
||||
|
||||
if ($^O eq 'MSWin32') {
|
||||
$savepath = $ENV{'USERPROFILE'} . '/Pictures';
|
||||
}
|
||||
|
||||
mkdir ($savepath) unless (-d $savepath);
|
||||
|
||||
if ( (lc($url) =~ /\.(gif|jpeg|png|webm|mp4)$/) and ($1 eq $extension) ){
|
||||
$savepath = $savepath . "/" . s/[^\w!., -#\:\?]/_/gr;
|
||||
} else {
|
||||
$savepath = $savepath . "/" . s/[^\w!., -#]\:\?/_/gr . ".$extension";
|
||||
}
|
||||
|
||||
$url = urlencode($url);
|
||||
my $http = HTTP::Tiny->new();
|
||||
$http->mirror($url, $savepath);
|
||||
undef $http;
|
||||
|
||||
if (($^O ne 'cygwin') and defined($IMAGEMAGICK)) {
|
||||
eval {
|
||||
if ((-f $savepath) and ($savepath =~ /(png|jpe?g|gif)$/i)){
|
||||
my $im = Image::Magick->new();
|
||||
my $rename = 1;
|
||||
my (undef, undef, undef, $format) = $im->Ping($savepath);
|
||||
|
||||
if (defined($format)) {
|
||||
$rename = 0 if (($format eq 'JPEG') and ($savepath =~ /jpe?g$/i));
|
||||
$rename = 0 if (($format eq 'GIF') and ($savepath =~ /gif$/i));
|
||||
$rename = 0 if (($format =~ /^PNG/) and ($savepath =~ /png$/i));
|
||||
rename $savepath, sprintf("%s.%s", $savepath, lc($format)) if ($rename == 1);
|
||||
}
|
||||
|
||||
undef $im; undef $rename;
|
||||
}
|
||||
}
|
||||
}
|
||||
undef $savepath;
|
||||
}
|
||||
|
||||
$active = 0;
|
||||
undef $url; undef $extension;
|
||||
}
|
||||
|
||||
sub is_picture($) {
|
||||
my $url = shift;
|
||||
$url = urlencode($url);
|
||||
my $r = undef;
|
||||
|
||||
my $http = HTTP::Tiny->new();
|
||||
$r = $http->request('HEAD', $url);
|
||||
undef $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;
|
||||
}
|
||||
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub urlencode($) {
|
||||
my $url = shift;
|
||||
my $urlobj = url $url;
|
||||
$url = $urlobj->as_string;
|
||||
undef $urlobj;
|
||||
return $url;
|
||||
}
|
||||
|
||||
sub loadliststatus($){
|
||||
my $listtype = shift;
|
||||
my $list = HexChat::plugin_pref_get($listtype);
|
||||
|
||||
unless (defined($list)) {
|
||||
savesetting('list', '0');
|
||||
$list = 0;
|
||||
}
|
||||
|
||||
undef $listtype;
|
||||
return $list;
|
||||
}
|
||||
|
||||
sub loadlist($){
|
||||
my $setting = shift;
|
||||
my $val = HexChat::plugin_pref_get($setting);
|
||||
|
||||
unless (defined($val)) {
|
||||
savesetting($setting, encode_base64('', ''));
|
||||
$val = '';
|
||||
}
|
||||
|
||||
my @values = map { decode_base64($_); } split(/ /, $val);
|
||||
undef $setting; undef $val;
|
||||
return @values;
|
||||
}
|
||||
|
||||
sub savelist(@) {
|
||||
my $setting = shift;
|
||||
my @list = map { encode_base64($_, ''); } @_;
|
||||
my $value = join(' ', @list);
|
||||
@list = -1; undef @list;
|
||||
return savesetting($setting, $value);
|
||||
}
|
||||
|
||||
sub savesetting(@) {
|
||||
my $setting = shift;
|
||||
my $value = shift;
|
||||
|
||||
if (HexChat::plugin_pref_set($setting, $value) == 0) {
|
||||
HexChat::printf("Unable to save settings for %s\n", $script_name);
|
||||
undef $setting; undef $value;
|
||||
return undef;
|
||||
}
|
||||
|
||||
undef $setting;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub dl_cmd {
|
||||
shift(@{$_[0]});
|
||||
my $cmd = shift(@{$_[0]});
|
||||
my $entity = shift(@{$_[0]});
|
||||
my $value = join(' ', @{$_[0]});
|
||||
HexChat::print("\n");
|
||||
my $msg = undef;
|
||||
|
||||
if (defined($cmd)) {
|
||||
if ($cmd eq 'enable') {
|
||||
if($entity eq 'nick') {
|
||||
if (defined(savesetting('dl_nicklist', '1'))) {
|
||||
$msg = "Nicks blacklist now enabled\n";
|
||||
}
|
||||
} elsif ($entity eq 'domain') {
|
||||
if (defined(savesetting('dl_domainlist', '1'))) {
|
||||
$msg = "Domains blacklist now enabled\n";
|
||||
}
|
||||
}
|
||||
} elsif ($cmd eq 'disable') {
|
||||
if($entity eq 'nick') {
|
||||
if (defined(savesetting('dl_nicklist', '0'))) {
|
||||
$msg = "Nicks blacklist now disabled\n";
|
||||
}
|
||||
} elsif ($entity eq 'domain') {
|
||||
if (defined(savesetting('dl_domainlist', '0'))) {
|
||||
$msg = "Domains blacklist now disabled\n";
|
||||
}
|
||||
}
|
||||
} elsif (($cmd eq 'show') or ($cmd eq 'info')) {
|
||||
$msg = '';
|
||||
|
||||
if (loadliststatus('dl_nicklist') == 0) {
|
||||
$msg .= "Nicks blacklist: disabled\n";
|
||||
} else {
|
||||
$msg .= "Nicks blacklist: enabled\n";
|
||||
}
|
||||
|
||||
$msg .= "Blacklisted nicks = " . join( ', ', loadlist('dl_nicks')) ."\n";
|
||||
|
||||
if (loadliststatus('dl_domainlist') == 0) {
|
||||
$msg .= "Domains blacklist: disabled\n";
|
||||
} else {
|
||||
$msg .= "Domains blacklist: enabled\n";
|
||||
}
|
||||
|
||||
$msg .= "Blacklisted domains = " . join( ', ', loadlist('dl_domains')) . "\n";
|
||||
} elsif ($cmd eq 'add') {
|
||||
if ((defined($entity)) and (defined($value))) {
|
||||
if ($entity eq 'nick') {
|
||||
my @nicks = (loadlist('dl_nicks'), $value);
|
||||
|
||||
unless (defined(savelist('dl_nicks', @nicks))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@nicks = -1; undef @nicks;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Nicks blacklist now: %s\n", join(', ', @nicks));
|
||||
@nicks = -1; undef @nicks;
|
||||
} elsif ($entity eq 'domain') {
|
||||
my @domains = (loadlist('dl_domains'), $value);
|
||||
|
||||
unless (defined(savelist('dl_domains', @domains))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@domains = -1; undef @domains;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Domains blacklist now: %s\n", join(', ', @domains));
|
||||
@domains = -1; undef @domains;
|
||||
}
|
||||
}
|
||||
} elsif ($cmd eq 'del') {
|
||||
if ((defined($entity)) and (defined($value))) {
|
||||
if ($entity eq 'nick') {
|
||||
my @list = loadlist('dl_nicks');
|
||||
my @nicklist;
|
||||
|
||||
foreach (@list) {
|
||||
next if ($_ eq $value);
|
||||
push @nicklist, $_;
|
||||
}
|
||||
|
||||
@list = -1; undef @list;
|
||||
|
||||
unless (defined(savelist('dl_nicks', @nicklist))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@nicklist = -1; undef @nicklist;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Nicks blacklist now: %s\n", join(', ', @nicklist));
|
||||
@nicklist = -1; undef @nicklist;
|
||||
} elsif ($entity eq 'domain') {
|
||||
my @list = loadlist('dl_domains');
|
||||
my @domainlist;
|
||||
|
||||
foreach (@list) {
|
||||
next if ($_ eq $value);
|
||||
push @domainlist, $_;
|
||||
}
|
||||
|
||||
@list = -1; undef @list;
|
||||
|
||||
unless (defined(savelist('dl_domains', @domainlist))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@domainlist = -1; undef @domainlist;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Domains blacklist now: %s\n", join(', ', @domainlist));
|
||||
@domainlist = -1; undef @domainlist;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
unless(defined($msg)) {
|
||||
HexChat::print($help);
|
||||
} else {
|
||||
HexChat::print($msg);
|
||||
}
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
sub freehooks {
|
||||
foreach (@hooks) {
|
||||
HexChat::unhook($_);
|
||||
}
|
||||
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
424
web_link_saver/unsafe/img_url_wget.pl
Normal file
424
web_link_saver/unsafe/img_url_wget.pl
Normal file
@@ -0,0 +1,424 @@
|
||||
# one of hexchat contributors said this on freenode's #hexchat
|
||||
# 2017-11-26 15:36 < TingPing> eleksir, the hexchat api isn't thread safe
|
||||
# on practice it developes to memory leak
|
||||
|
||||
use HexChat qw(:all);
|
||||
use threads;
|
||||
use threads::shared;
|
||||
|
||||
use strict;
|
||||
use warnings "all";
|
||||
|
||||
use MIME::Base64;
|
||||
use URI::URL;
|
||||
my $IMAGEMAGICK = undef; # use on demand, perl that shipped with hexchat-2.12.4 on windows miss this module
|
||||
if ($^O ne 'cygwin') { # cygwin 2.882 64-bit has broken Image::Magick
|
||||
$IMAGEMAGICK = eval {
|
||||
require Image::Magick;
|
||||
import Image::Magick qw(ping);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
sub dlfunc($); # thread, that checks and downloads stuff
|
||||
sub is_picture($);
|
||||
sub urlencode($);
|
||||
sub hookfn;
|
||||
sub loadliststatus($);
|
||||
sub loadlist($);
|
||||
sub savelist(@);
|
||||
sub savesetting(@);
|
||||
sub dl_cmd;
|
||||
sub freehooks;
|
||||
|
||||
my $wgetpath; share($wgetpath);
|
||||
|
||||
my $script_name = "Image URL Downloader";
|
||||
HexChat::register($script_name, '0.10', 'Automatically downloads image URLs via wget', \&freehooks);
|
||||
|
||||
HexChat::print("$script_name loaded\n");
|
||||
my $help = 'Usage:
|
||||
/dl enable nick|domain <name> - enable nick or domain blacklist
|
||||
/dl disable nick|domain <name> - disable nick or domain blacklist
|
||||
/dl add nick|domain <name> - adds nick or domain to apropriate blacklist
|
||||
/dl del nick|domain <name> - removes nick or domain from apropriate blacklist
|
||||
/dl show - show blacklists
|
||||
/dl info - same as above
|
||||
';
|
||||
my @hooks;
|
||||
push @hooks, HexChat::hook_print('Channel Message', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Msg Hilight', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Action', \&hookfn);
|
||||
push @hooks, HexChat::hook_print('Channel Action Hilight', \&hookfn);
|
||||
push @hooks, HexChat::hook_command('dl', \&dl_cmd);
|
||||
|
||||
my $active = 0;
|
||||
share($active);
|
||||
|
||||
sub hookfn {
|
||||
my ($nick, $text, $modechar) = @{$_[0]};
|
||||
my $nicklist = loadliststatus('dl_nicklist');
|
||||
|
||||
if ($nicklist != 0) {
|
||||
my @nicklist = loadlist('dl_nicks');
|
||||
|
||||
foreach (@nicklist) {
|
||||
next unless(defined($_));
|
||||
next if($_ eq '');
|
||||
|
||||
if ($_ eq $nick) {
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
undef $nicklist;
|
||||
@nicklist = -1; undef @nicklist;
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
@nicklist = -1; undef @nicklist;
|
||||
}
|
||||
|
||||
undef $nicklist;
|
||||
|
||||
my @words = split(/\s+/, $text);
|
||||
|
||||
foreach (@words) {
|
||||
my $str = $_;
|
||||
next unless(substr($str, 0, 4) eq 'http');
|
||||
|
||||
if ($str =~ m{https?://([a-zA-Z0-9.-]+\.[a-zA-Z]+)/(?:.*)}) {
|
||||
my $domain = $1;
|
||||
my $domainlist = loadliststatus('dl_domainlist');
|
||||
|
||||
if ($domainlist != 0) {
|
||||
my @domainlist = loadlist('dl_domains');
|
||||
|
||||
foreach (@domainlist) {
|
||||
next unless(defined($_));
|
||||
next if($_ eq '');
|
||||
|
||||
if ($_ eq $domain) {
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
@words = -1; undef @words;
|
||||
undef $str; undef $domain;
|
||||
undef $domainlist;
|
||||
@domainlist = -1; undef @domainlist;
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
}
|
||||
|
||||
@domainlist = -1, undef @domainlist;
|
||||
}
|
||||
|
||||
undef $domainlist;
|
||||
|
||||
$active = 1;
|
||||
my $t = undef;
|
||||
|
||||
do {
|
||||
$t = threads->create('dlfunc', $str);
|
||||
sleep 1 unless(defined($t));
|
||||
} unless (defined($t));
|
||||
|
||||
$t->detach;
|
||||
undef $t;
|
||||
|
||||
if ($active == 1) {
|
||||
HexChat::hook_timer( 100, sub { return REMOVE if ($active == 0); return KEEP; } );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@words = -1; undef @words;
|
||||
undef $nick; undef $text; undef $modechar;
|
||||
|
||||
return HexChat::EAT_NONE;
|
||||
}
|
||||
|
||||
sub dlfunc($) {
|
||||
my $url = shift;
|
||||
|
||||
if (-f "/bin/wget") {
|
||||
$wgetpath = '/bin/wget';
|
||||
} elsif (-f "/usr/bin/wget") {
|
||||
$wgetpath = '/usr/bin/wget';
|
||||
} elsif (-f "/usr/local/bin/wget") {
|
||||
$wgetpath = '/usr/local/bin/wget';
|
||||
} elsif (-f "c:\\perl\\bin\\wget.exe") {
|
||||
$wgetpath = "c:\\perl\\bin\\wget.exe";
|
||||
} elsif (-f "c:\\perl64\\bin\\wget.exe") {
|
||||
$wgetpath = "c:\\perl64\\bin\\wget.exe";
|
||||
} elsif (-f "$ENV{'PROGRAMFILES'}\\perl\\bin\\wget.exe") {
|
||||
$wgetpath = "$ENV{'PROGRAMFILES'}\\perl\\bin\\wget.exe";
|
||||
} elsif (-f "$ENV{'PROGRAMFILES'}\\perl64\\bin\\wget.exe") {
|
||||
$wgetpath = "$ENV{'PROGRAMFILES'}\\perl64\\bin\\wget.exe";
|
||||
}
|
||||
|
||||
my $extension = is_picture($url);
|
||||
|
||||
if (defined($extension)) {
|
||||
my $savepath = sprintf("%s/imgsave", HexChat::get_info("configdir"));
|
||||
|
||||
if ($^O eq 'MSWin32') {
|
||||
$savepath = $ENV{'USERPROFILE'} . '/Pictures';
|
||||
}
|
||||
|
||||
mkdir ($savepath) unless (-d $savepath);
|
||||
|
||||
if ( (lc($url) =~ /\.(gif|jpeg|png|webm|mp4)$/) and ($1 eq $extension) ){
|
||||
$savepath = $savepath . "/" . s/[^\w!., -#\?\:]/_/gr;
|
||||
} else {
|
||||
$savepath = $savepath . "/" . s/[^\w!., -#\?\:]/_/gr . ".$extension";
|
||||
}
|
||||
|
||||
$url = urlencode($url);
|
||||
system($wgetpath, '--no-check-certificate', '-q', '-T', '20', '-O', $savepath, '-o', '/dev/null', "$url");
|
||||
|
||||
if (($^O ne 'cygwin') and defined($IMAGEMAGICK)) {
|
||||
eval {
|
||||
if ($savepath =~ /(png|jpe?g|gif)$/i){
|
||||
my $im = Image::Magick->new();
|
||||
my $rename = 1;
|
||||
my (undef, undef, undef, $format) = $im->Ping($savepath);
|
||||
|
||||
if (defined($format)) {
|
||||
$rename = 0 if (($format eq 'JPEG') and ($savepath =~ /jpe?g$/i));
|
||||
$rename = 0 if (($format eq 'GIF') and ($savepath =~ /gif$/i));
|
||||
$rename = 0 if (($format =~ /^PNG/) and ($savepath =~ /png$/i));
|
||||
rename $savepath, sprintf("%s.%s", $savepath, lc($format)) if ($rename == 1);
|
||||
}
|
||||
|
||||
undef $im; undef $rename;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
undef $savepath;
|
||||
}
|
||||
|
||||
$active = 0;
|
||||
undef $url; undef $extension;
|
||||
}
|
||||
|
||||
sub is_picture($) {
|
||||
my $url = shift;
|
||||
$url = urlencode($url);
|
||||
my $r = undef;
|
||||
|
||||
$r = `$wgetpath --no-check-certificate -q --method=HEAD -S --timeout=5 "$url" 2>&1`;
|
||||
undef $url;
|
||||
|
||||
if ($? == 0) {
|
||||
foreach (split(/\n/, $r)) {
|
||||
next unless($_ =~ /Content\-Type: (.+)/);
|
||||
$r = ($1); chomp($r);
|
||||
last;
|
||||
}
|
||||
|
||||
if (defined($r)) {
|
||||
if ($r =~ /^image\/gif/) { $r = 'gif'; }
|
||||
elsif ($r =~ /^image\/jpe?g/){ $r = 'jpeg';}
|
||||
elsif ($r =~ /^image\/png/) { $r = 'png'; }
|
||||
elsif ($r =~ /^video\/webm/) { $r = 'webm';}
|
||||
elsif ($r =~ /^video\/mp4/) { $r = 'mp4'; }
|
||||
else { $r = undef; }
|
||||
} else {
|
||||
$r = undef;
|
||||
}
|
||||
} else {
|
||||
$r = undef;
|
||||
}
|
||||
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub urlencode($) {
|
||||
my $url = shift;
|
||||
my $urlobj = url $url;
|
||||
$url = $urlobj->as_string;
|
||||
undef $urlobj;
|
||||
return $url;
|
||||
}
|
||||
|
||||
sub loadliststatus($){
|
||||
my $listtype = shift;
|
||||
my $list = HexChat::plugin_pref_get($listtype);
|
||||
|
||||
unless (defined($list)) {
|
||||
savesetting('list', '0');
|
||||
$list = 0;
|
||||
}
|
||||
|
||||
undef $listtype;
|
||||
return $list;
|
||||
}
|
||||
|
||||
sub loadlist($){
|
||||
my $setting = shift;
|
||||
my $val = HexChat::plugin_pref_get($setting);
|
||||
|
||||
unless (defined($val)) {
|
||||
savesetting($setting, encode_base64('', ''));
|
||||
$val = '';
|
||||
}
|
||||
|
||||
my @values = map { decode_base64($_); } split(/ /, $val);
|
||||
undef $setting; undef $val;
|
||||
return @values;
|
||||
}
|
||||
|
||||
sub savelist(@) {
|
||||
my $setting = shift;
|
||||
my @list = map { encode_base64($_, ''); } @_;
|
||||
my $value = join(' ', @list);
|
||||
@list = -1; undef @list;
|
||||
return savesetting($setting, $value);
|
||||
}
|
||||
|
||||
sub savesetting(@) {
|
||||
my $setting = shift;
|
||||
my $value = shift;
|
||||
|
||||
if (HexChat::plugin_pref_set($setting, $value) == 0) {
|
||||
HexChat::printf("Unable to save settings for %s\n", $script_name);
|
||||
undef $setting; undef $value;
|
||||
return undef;
|
||||
}
|
||||
|
||||
undef $setting;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub dl_cmd {
|
||||
shift(@{$_[0]});
|
||||
my $cmd = shift(@{$_[0]});
|
||||
my $entity = shift(@{$_[0]});
|
||||
my $value = join(' ', @{$_[0]});
|
||||
HexChat::print("\n");
|
||||
my $msg = undef;
|
||||
|
||||
if (defined($cmd)) {
|
||||
if ($cmd eq 'enable') {
|
||||
if($entity eq 'nick') {
|
||||
if (defined(savesetting('dl_nicklist', '1'))) {
|
||||
$msg = "Nicks blacklist now enabled\n";
|
||||
}
|
||||
} elsif ($entity eq 'domain') {
|
||||
if (defined(savesetting('dl_domainlist', '1'))) {
|
||||
$msg = "Domains blacklist now enabled\n";
|
||||
}
|
||||
}
|
||||
} elsif ($cmd eq 'disable') {
|
||||
if($entity eq 'nick') {
|
||||
if (defined(savesetting('dl_nicklist', '0'))) {
|
||||
$msg = "Nicks blacklist now disabled\n";
|
||||
}
|
||||
} elsif ($entity eq 'domain') {
|
||||
if (defined(savesetting('dl_domainlist', '0'))) {
|
||||
$msg = "Domains blacklist now disabled\n";
|
||||
}
|
||||
}
|
||||
} elsif (($cmd eq 'show') or ($cmd eq 'info')) {
|
||||
$msg = '';
|
||||
|
||||
if (loadliststatus('dl_nicklist') == 0) {
|
||||
$msg .= "Nicks blacklist: disabled\n";
|
||||
} else {
|
||||
$msg .= "Nicks blacklist: enabled\n";
|
||||
}
|
||||
|
||||
$msg .= "Blacklisted nicks = " . join( ', ', loadlist('dl_nicks')) ."\n";
|
||||
|
||||
if (loadliststatus('dl_domainlist') == 0) {
|
||||
$msg .= "Domains blacklist: disabled\n";
|
||||
} else {
|
||||
$msg .= "Domains blacklist: enabled\n";
|
||||
}
|
||||
|
||||
$msg .= "Blacklisted domains = " . join( ', ', loadlist('dl_domains')) . "\n";
|
||||
} elsif ($cmd eq 'add') {
|
||||
if ((defined($entity)) and (defined($value))) {
|
||||
if ($entity eq 'nick') {
|
||||
my @nicks = (loadlist('dl_nicks'), $value);
|
||||
|
||||
unless (defined(savelist('dl_nicks', @nicks))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@nicks = -1; undef @nicks;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Nicks blacklist now: %s\n", join(', ', @nicks));
|
||||
@nicks = -1; undef @nicks;
|
||||
} elsif ($entity eq 'domain') {
|
||||
my @domains = (loadlist('dl_domains'), $value);
|
||||
|
||||
unless (defined(savelist('dl_domains', @domains))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@domains = -1; undef @domains;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Domains blacklist now: %s\n", join(', ', @domains));
|
||||
@domains = -1; undef @domains;
|
||||
}
|
||||
}
|
||||
} elsif ($cmd eq 'del') {
|
||||
if ((defined($entity)) and (defined($value))) {
|
||||
if ($entity eq 'nick') {
|
||||
my @list = loadlist('dl_nicks');
|
||||
my @nicklist;
|
||||
|
||||
foreach (@list) {
|
||||
next if ($_ eq $value);
|
||||
push @nicklist, $_;
|
||||
}
|
||||
|
||||
@list = -1; undef @list;
|
||||
|
||||
unless (defined(savelist('dl_nicks', @nicklist))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@nicklist = -1; undef @nicklist;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Nicks blacklist now: %s\n", join(', ', @nicklist));
|
||||
@nicklist = -1; undef @nicklist;
|
||||
} elsif ($entity eq 'domain') {
|
||||
my @list = loadlist('dl_domains');
|
||||
my @domainlist;
|
||||
|
||||
foreach (@list) {
|
||||
next if ($_ eq $value);
|
||||
push @domainlist, $_;
|
||||
}
|
||||
|
||||
@list = -1; undef @list;
|
||||
|
||||
unless (defined(savelist('dl_domains', @domainlist))) {
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
@domainlist = -1; undef @domainlist;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
$msg = sprintf("Domains blacklist now: %s\n", join(', ', @domainlist));
|
||||
@domainlist = -1; undef @domainlist;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
unless(defined($msg)) {
|
||||
HexChat::print($help);
|
||||
} else {
|
||||
HexChat::print($msg);
|
||||
}
|
||||
undef $cmd; undef $entity; undef $value; undef $msg;
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
|
||||
sub freehooks {
|
||||
foreach (@hooks) {
|
||||
HexChat::unhook($_);
|
||||
}
|
||||
|
||||
return HexChat::EAT_ALL;
|
||||
}
|
||||
Reference in New Issue
Block a user