1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
package MasterServer::Core::Util;
use strict;
use warnings;
use IP::Country::Fast;
use Socket;
use POSIX qw/strftime/;
use Exporter 'import';
our @EXPORT = qw| ip2country host2ip valid_address db_all sqlprint |;
################################################################################
## return the abbreviated country name based on IP
################################################################################
sub ip2country {
my ($self, $ip) = @_;
my $reg = IP::Country::Fast->new();
return $reg->inet_atocc($ip);
}
################################################################################
## return IP of a hostname
################################################################################
sub host2ip {
my ($self, $name) = @_;
my $unpack = inet_aton($name) if $name;
return inet_ntoa($unpack) if $unpack;
}
################################################################################
## Verify whether a given domain name or IP address and port are valid.
## returns 1/0 if valid/invalid ip + port. IPv4 ONLY!
################################################################################
sub valid_address {
my ($self, $a, $p) = @_;
# check if ip and port are in valid range
my $val_addr = ($a =~ '^(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)\.){3}(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)$') if $a;
my $val_port = ($p =~ m/^\d+$/ && 0 < $p && $p <= 65535) if $p;
# exclude addresses where we don't want people sniffing
for (qw|192.168.(.\d*).(.\d*) 127.0.(.\d*).(.\d*) 10.0.(.\d*).(.\d*)|){$val_addr = 0 if ($a =~ m/$_/)}
# only return true if both are valid
return ($val_addr && $val_port);
}
################################################################################
# Adaptation of TUWF's dbAll sql function
################################################################################
sub db_all {
my $self = shift;
my $sqlq = shift;
my $s = $self->{dbh};
$sqlq =~ s/\r?\n/ /g;
$sqlq =~ s/ +/ /g;
my(@q) = @_ ? sqlprint($sqlq, @_) : ($sqlq);
my($q, $r);
my $ret = eval {
$q = $s->prepare($q[0]);
$q->execute($#q ? @q[1..$#q] : ());
$r = $q->fetchall_arrayref({});
$q->finish();
1;
};
$r = [] if (!$r || ref($r) ne 'ARRAY');
return $r;
}
################################################################################
# sqlprint (TUWF, Yorhel):
# ? normal placeholder
# !l list of placeholders, expects arrayref
# !H list of SET-items, expects hashref or arrayref: format => (bind_value || \@bind_values)
# !W same as !H, but for WHERE clauses (AND'ed together)
# !s the classic sprintf %s, use with care
# This isn't sprintf, so all other things won't work,
# Only the ? placeholder is supported, so no dollar sign numbers or named placeholders
################################################################################
sub sqlprint { # query, bind values. Returns new query + bind values
my @a;
my $q='';
for my $p (split /(\?|![lHWs])/, shift) {
next if !defined $p;
if($p eq '?') {
push @a, shift;
$q .= $p;
} elsif($p eq '!s') {
$q .= shift;
} elsif($p eq '!l') {
my $l = shift;
$q .= join ', ', map '?', 0..$#$l;
push @a, @$l;
} elsif($p eq '!H' || $p eq '!W') {
my $h=shift;
my @h=ref $h eq 'HASH' ? %$h : @$h;
my @r;
while(my($k,$v) = (shift(@h), shift(@h))) {
last if !defined $k;
my($n,@l) = sqlprint($k, ref $v eq 'ARRAY' ? @$v : $v);
push @r, $n;
push @a, @l;
}
$q .= ($p eq '!W' ? 'WHERE ' : 'SET ').join $p eq '!W' ? ' AND ' : ', ', @r
if @r;
} else {
$q .= $p;
}
}
return($q, @a);
}
1;
|
