line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# P2P::pDonkey::Meta.pm |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Copyright (c) 2003-2004 Alexey klimkin . |
4
|
|
|
|
|
|
|
# All rights reserved. |
5
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
6
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
package P2P::pDonkey::Meta; |
9
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
6449
|
use 5.006; |
|
5
|
|
|
|
|
18
|
|
|
5
|
|
|
|
|
198
|
|
11
|
5
|
|
|
5
|
|
28
|
use strict; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
148
|
|
12
|
5
|
|
|
5
|
|
24
|
use warnings; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
1235
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
require Exporter; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our %EXPORT_TAGS = |
21
|
|
|
|
|
|
|
( 'all' => [ qw( |
22
|
|
|
|
|
|
|
MetaTagName |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
DLS_HASHING |
25
|
|
|
|
|
|
|
DLS_QUEUED |
26
|
|
|
|
|
|
|
DLS_LOOKING |
27
|
|
|
|
|
|
|
DLS_DOWNLOADING |
28
|
|
|
|
|
|
|
DLS_PAUSED |
29
|
|
|
|
|
|
|
DLS_IDS |
30
|
|
|
|
|
|
|
DLS_NOSOURCES |
31
|
|
|
|
|
|
|
DLS_DONE |
32
|
|
|
|
|
|
|
DLS_HASHING2 |
33
|
|
|
|
|
|
|
DLS_ERRORLOADING |
34
|
|
|
|
|
|
|
DLS_COMPLETING |
35
|
|
|
|
|
|
|
DLS_COMPLETE |
36
|
|
|
|
|
|
|
DLS_CORRUPTED |
37
|
|
|
|
|
|
|
DLS_ERRORHASHING |
38
|
|
|
|
|
|
|
DLS_TRANSFERRING |
39
|
|
|
|
|
|
|
FPRI_LOW |
40
|
|
|
|
|
|
|
FPRI_NORMAL |
41
|
|
|
|
|
|
|
FPRI_HIGH |
42
|
|
|
|
|
|
|
SPRI_LOW |
43
|
|
|
|
|
|
|
SPRI_NORMAL |
44
|
|
|
|
|
|
|
SPRI_HIGH |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
SZ_FILEPART |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
VT_STRING VT_INTEGER |
49
|
|
|
|
|
|
|
ST_COMBINE ST_AND ST_OR ST_ANDNOT |
50
|
|
|
|
|
|
|
ST_NAME |
51
|
|
|
|
|
|
|
ST_META |
52
|
|
|
|
|
|
|
ST_MINMAX ST_MIN ST_MAX |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
TT_UNDEFINED |
55
|
|
|
|
|
|
|
TT_NAME TT_SIZE TT_TYPE TT_FORMAT TT_COPIED TT_GAPSTART TT_GAPEND |
56
|
|
|
|
|
|
|
TT_DESCRIPTION TT_PING TT_FAIL TT_PREFERENCE TT_PORT TT_IP TT_VERSION |
57
|
|
|
|
|
|
|
TT_TEMPFILE TT_PRIORITY TT_STATUS TT_AVAILABILITY |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
packB unpackB |
60
|
|
|
|
|
|
|
packW unpackW |
61
|
|
|
|
|
|
|
packD unpackD |
62
|
|
|
|
|
|
|
packF unpackF |
63
|
|
|
|
|
|
|
packS unpackS |
64
|
|
|
|
|
|
|
packSList unpackSList |
65
|
|
|
|
|
|
|
packHash unpackHash |
66
|
|
|
|
|
|
|
packHashList unpackHashList |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
packMetaTagName unpackMetaTagName |
69
|
|
|
|
|
|
|
packMeta unpackMeta printMeta makeMeta sameMetaType |
70
|
|
|
|
|
|
|
packMetaList unpackMetaList printMetaList |
71
|
|
|
|
|
|
|
packMetaListU unpackMetaListU printMetaListU |
72
|
|
|
|
|
|
|
MetaListU2MetaList MetaList2MetaListU |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
packInfo unpackInfo makeClientInfo makeServerInfo printInfo |
75
|
|
|
|
|
|
|
packInfoList unpackInfoList printInfoList |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
packFileInfo unpackFileInfo makeFileInfo |
78
|
|
|
|
|
|
|
packFileInfoList unpackFileInfoList makeFileInfoList |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
packSearchQuery unpackSearchQuery matchSearchQuery makeSQLExpr |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
packAddr unpackAddr printAddr idAddr |
83
|
|
|
|
|
|
|
packAddrList unpackAddrList |
84
|
|
|
|
|
|
|
) ], |
85
|
|
|
|
|
|
|
'tags' => [ qw( |
86
|
|
|
|
|
|
|
SZ_FILEPART |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
VT_STRING VT_INTEGER |
89
|
|
|
|
|
|
|
ST_COMBINE ST_AND ST_OR ST_ANDNOT |
90
|
|
|
|
|
|
|
ST_NAME |
91
|
|
|
|
|
|
|
ST_META |
92
|
|
|
|
|
|
|
ST_MINMAX ST_MIN ST_MAX |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
TT_UNDEFINED |
95
|
|
|
|
|
|
|
TT_NAME TT_SIZE TT_TYPE TT_FORMAT TT_COPIED TT_GAPSTART TT_GAPEND |
96
|
|
|
|
|
|
|
TT_DESCRIPTION TT_PING TT_FAIL TT_PREFERENCE TT_PORT TT_IP TT_VERSION |
97
|
|
|
|
|
|
|
TT_TEMPFILE TT_PRIORITY TT_STATUS TT_AVAILABILITY |
98
|
|
|
|
|
|
|
) ] |
99
|
|
|
|
|
|
|
); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
our @EXPORT = qw( |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Preloaded methods go here. |
109
|
|
|
|
|
|
|
|
110
|
5
|
|
|
5
|
|
27
|
use Carp; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
374
|
|
111
|
5
|
|
|
5
|
|
26
|
use File::Glob ':glob'; |
|
5
|
|
|
|
|
18
|
|
|
5
|
|
|
|
|
1373
|
|
112
|
5
|
|
|
5
|
|
4696
|
use Tie::IxHash; |
|
5
|
|
|
|
|
25563
|
|
|
5
|
|
|
|
|
161
|
|
113
|
5
|
|
|
5
|
|
10139
|
use Digest::MD4 qw( md4_hex ); |
|
5
|
|
|
|
|
5234
|
|
|
5
|
|
|
|
|
338
|
|
114
|
5
|
|
|
5
|
|
37
|
use File::Basename; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
501
|
|
115
|
5
|
|
|
5
|
|
28
|
use File::Find; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
285
|
|
116
|
5
|
|
|
5
|
|
3659
|
use POSIX qw( ceil ); |
|
5
|
|
|
|
|
20687
|
|
|
5
|
|
|
|
|
33
|
|
117
|
5
|
|
|
5
|
|
8098
|
use P2P::pDonkey::Util qw( ip2addr ); |
|
5
|
|
|
|
|
16
|
|
|
5
|
|
|
|
|
513
|
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
#use Video::Info; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
my $debug = 0; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
my @MetaTagName; |
124
|
|
|
|
|
|
|
sub MetaTagName { |
125
|
747
|
|
|
747
|
0
|
1893
|
return $MetaTagName[$_[0]]; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# --- Download status byte |
129
|
5
|
|
|
5
|
|
29
|
use constant DLS_HASHING => 0x00; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
359
|
|
130
|
5
|
|
|
5
|
|
26
|
use constant DLS_QUEUED => 0x01; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
209
|
|
131
|
5
|
|
|
5
|
|
25
|
use constant DLS_LOOKING => 0x02; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
205
|
|
132
|
5
|
|
|
5
|
|
24
|
use constant DLS_DOWNLOADING => 0x03; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
235
|
|
133
|
5
|
|
|
5
|
|
26
|
use constant DLS_PAUSED => 0x04; |
|
5
|
|
|
|
|
42
|
|
|
5
|
|
|
|
|
214
|
|
134
|
5
|
|
|
5
|
|
43
|
use constant DLS_IDS => 0x05; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
233
|
|
135
|
5
|
|
|
5
|
|
25
|
use constant DLS_NOSOURCES => 0x06; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
212
|
|
136
|
5
|
|
|
5
|
|
27
|
use constant DLS_DONE => 0x07; |
|
5
|
|
|
|
|
35
|
|
|
5
|
|
|
|
|
190
|
|
137
|
5
|
|
|
5
|
|
24
|
use constant DLS_HASHING2 => 0x08; |
|
5
|
|
|
|
|
20
|
|
|
5
|
|
|
|
|
197
|
|
138
|
5
|
|
|
5
|
|
24
|
use constant DLS_ERRORLOADING => 0x09; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
181
|
|
139
|
5
|
|
|
5
|
|
23
|
use constant DLS_COMPLETING => 0x0a; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
301
|
|
140
|
5
|
|
|
5
|
|
22
|
use constant DLS_COMPLETE => 0x0b; |
|
5
|
|
|
|
|
19
|
|
|
5
|
|
|
|
|
194
|
|
141
|
5
|
|
|
5
|
|
25
|
use constant DLS_CORRUPTED => 0x0c; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
211
|
|
142
|
5
|
|
|
5
|
|
32
|
use constant DLS_ERRORHASHING => 0x0d; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
175
|
|
143
|
5
|
|
|
5
|
|
23
|
use constant DLS_TRANSFERRING => 0x0e; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
180
|
|
144
|
|
|
|
|
|
|
# --- File priority |
145
|
5
|
|
|
5
|
|
22
|
use constant FPRI_LOW => 0x00; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
176
|
|
146
|
5
|
|
|
5
|
|
22
|
use constant FPRI_NORMAL => 0x01; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
170
|
|
147
|
5
|
|
|
5
|
|
21
|
use constant FPRI_HIGH => 0x02; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
162
|
|
148
|
|
|
|
|
|
|
# --- Server priority |
149
|
5
|
|
|
5
|
|
22
|
use constant SPRI_LOW => 0x02; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
164
|
|
150
|
5
|
|
|
5
|
|
22
|
use constant SPRI_NORMAL => 0x00; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
167
|
|
151
|
5
|
|
|
5
|
|
21
|
use constant SPRI_HIGH => 0x01; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
195
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# --- known sizes of pieces |
154
|
5
|
|
|
5
|
|
21
|
use constant SZ_FILEPART => 9500*1024; # v 0.4.x |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
194
|
|
155
|
5
|
|
|
5
|
|
22
|
use constant SZ_B_FILEPART => 9728000; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
188
|
|
156
|
5
|
|
|
5
|
|
26
|
use constant SZ_S_FILEPART => 486400; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
179
|
|
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# -- tag bytes in file info |
159
|
5
|
|
|
5
|
|
20
|
use constant FI_DESCRIPTION => 0x2; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
270
|
|
160
|
5
|
|
|
5
|
|
21
|
use constant FI_PART_HASHES => 0x1; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
179
|
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# --- value types |
163
|
5
|
|
|
5
|
|
21
|
use constant VT_STRING => 0x02; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
200
|
|
164
|
5
|
|
|
5
|
|
21
|
use constant VT_INTEGER => 0x03; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
184
|
|
165
|
5
|
|
|
5
|
|
20
|
use constant VT_FLOAT => 0x04; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
176
|
|
166
|
|
|
|
|
|
|
# --- search query constants |
167
|
|
|
|
|
|
|
# - search type |
168
|
5
|
|
|
5
|
|
21
|
use constant ST_COMBINE => 0x0; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
178
|
|
169
|
5
|
|
|
5
|
|
25
|
use constant ST_NAME => 0x1; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
207
|
|
170
|
5
|
|
|
5
|
|
21
|
use constant ST_META => 0x2; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
188
|
|
171
|
5
|
|
|
5
|
|
22
|
use constant ST_MINMAX => 0x3; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
396
|
|
172
|
|
|
|
|
|
|
# - search logic op for combined |
173
|
5
|
|
|
5
|
|
24
|
use constant ST_AND => 0x0; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
204
|
|
174
|
5
|
|
|
5
|
|
19
|
use constant ST_OR => 0x1; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
189
|
|
175
|
5
|
|
|
5
|
|
27
|
use constant ST_ANDNOT => 0x2; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
186
|
|
176
|
|
|
|
|
|
|
# - constants for ST_MINMAX |
177
|
5
|
|
|
5
|
|
35
|
use constant ST_MIN => 0x1; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
203
|
|
178
|
5
|
|
|
5
|
|
21
|
use constant ST_MAX => 0x2; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
196
|
|
179
|
|
|
|
|
|
|
# --- tag types |
180
|
5
|
|
|
5
|
|
22
|
use constant TT_UNDEFINED => 0x00; |
|
5
|
|
|
|
|
15
|
|
|
5
|
|
|
|
|
204
|
|
181
|
5
|
|
|
5
|
|
23
|
use constant TT_NAME => 0x01; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
222
|
|
182
|
5
|
|
|
5
|
|
22
|
use constant TT_SIZE => 0x02; |
|
5
|
|
|
|
|
44
|
|
|
5
|
|
|
|
|
192
|
|
183
|
5
|
|
|
5
|
|
23
|
use constant TT_TYPE => 0x03; # Audio, Video, Image, Pro, Doc, Col |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
204
|
|
184
|
5
|
|
|
5
|
|
20
|
use constant TT_FORMAT => 0x04; # file extension |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
186
|
|
185
|
5
|
|
|
5
|
|
23
|
use constant TT_COPIED => 0x08; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
168
|
|
186
|
5
|
|
|
5
|
|
27
|
use constant TT_GAPSTART => 0x09; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
179
|
|
187
|
5
|
|
|
5
|
|
22
|
use constant TT_GAPEND => 0x0a; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
198
|
|
188
|
5
|
|
|
5
|
|
23
|
use constant TT_DESCRIPTION => 0x0b; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
199
|
|
189
|
5
|
|
|
5
|
|
22
|
use constant TT_PING => 0x0c; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
216
|
|
190
|
5
|
|
|
5
|
|
22
|
use constant TT_FAIL => 0x0d; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
186
|
|
191
|
5
|
|
|
5
|
|
26
|
use constant TT_PREFERENCE => 0x0e; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
222
|
|
192
|
5
|
|
|
5
|
|
80
|
use constant TT_PORT => 0x0f; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
192
|
|
193
|
5
|
|
|
5
|
|
56
|
use constant TT_IP => 0x10; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
212
|
|
194
|
5
|
|
|
5
|
|
23
|
use constant TT_VERSION => 0x11; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
198
|
|
195
|
5
|
|
|
5
|
|
23
|
use constant TT_TEMPFILE => 0x12; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
205
|
|
196
|
5
|
|
|
5
|
|
53
|
use constant TT_PRIORITY => 0x13; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
193
|
|
197
|
5
|
|
|
5
|
|
21
|
use constant TT_STATUS => 0x14; |
|
5
|
|
|
|
|
36
|
|
|
5
|
|
|
|
|
179
|
|
198
|
5
|
|
|
5
|
|
21
|
use constant TT_AVAILABILITY => 0x15; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
54172
|
|
199
|
|
|
|
|
|
|
$MetaTagName[TT_NAME] = 'Name'; |
200
|
|
|
|
|
|
|
$MetaTagName[TT_SIZE] = 'Size'; |
201
|
|
|
|
|
|
|
$MetaTagName[TT_TYPE] = 'Type'; |
202
|
|
|
|
|
|
|
$MetaTagName[TT_FORMAT] = 'Format'; |
203
|
|
|
|
|
|
|
$MetaTagName[TT_COPIED] = 'Copied'; |
204
|
|
|
|
|
|
|
$MetaTagName[TT_GAPSTART] = 'Gap start'; |
205
|
|
|
|
|
|
|
$MetaTagName[TT_GAPEND] = 'Gap end'; |
206
|
|
|
|
|
|
|
$MetaTagName[TT_DESCRIPTION] = 'Description'; |
207
|
|
|
|
|
|
|
$MetaTagName[TT_PING] = 'Ping'; |
208
|
|
|
|
|
|
|
$MetaTagName[TT_FAIL] = 'Fail'; |
209
|
|
|
|
|
|
|
$MetaTagName[TT_PREFERENCE] = 'Preference'; |
210
|
|
|
|
|
|
|
$MetaTagName[TT_PORT] = 'Port'; |
211
|
|
|
|
|
|
|
$MetaTagName[TT_IP] = 'IP'; |
212
|
|
|
|
|
|
|
$MetaTagName[TT_VERSION] = 'Version'; |
213
|
|
|
|
|
|
|
$MetaTagName[TT_TEMPFILE] = 'Temp file'; |
214
|
|
|
|
|
|
|
$MetaTagName[TT_PRIORITY] = 'Priority'; |
215
|
|
|
|
|
|
|
$MetaTagName[TT_STATUS] = 'Status'; |
216
|
|
|
|
|
|
|
$MetaTagName[TT_AVAILABILITY] = 'Availability'; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# basic pack/unpack functions |
219
|
|
|
|
|
|
|
sub unpackB { |
220
|
1133
|
|
|
1133
|
0
|
1141
|
my $res; |
221
|
1133
|
100
|
|
|
|
1986
|
if (defined $_[1]) { |
222
|
1132
|
|
|
|
|
2501
|
$res = unpack("x$_[1] C", $_[0]); |
223
|
1132
|
50
|
|
|
|
2563
|
$_[1] += 1 if defined $res; |
224
|
|
|
|
|
|
|
} else { |
225
|
1
|
|
|
|
|
3
|
$res = unpack('C', $_[0]); |
226
|
|
|
|
|
|
|
} |
227
|
1133
|
|
|
|
|
2389
|
return $res; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub unpackW { |
231
|
79
|
|
|
79
|
0
|
83
|
my $res; |
232
|
79
|
100
|
|
|
|
135
|
if (defined $_[1]) { |
233
|
78
|
|
|
|
|
172
|
$res = unpack("x$_[1] S", $_[0]); |
234
|
78
|
50
|
|
|
|
185
|
$_[1] += 2 if defined $res; |
235
|
|
|
|
|
|
|
} else { |
236
|
1
|
|
|
|
|
4
|
$res = unpack('S', $_[0]); |
237
|
|
|
|
|
|
|
} |
238
|
79
|
|
|
|
|
197
|
return $res; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub unpackD { |
242
|
708
|
|
|
708
|
0
|
922
|
my $res; |
243
|
708
|
100
|
|
|
|
1204
|
if (defined $_[1]) { |
244
|
707
|
|
|
|
|
1532
|
$res = unpack("x$_[1] L", $_[0]); |
245
|
707
|
50
|
|
|
|
1704
|
$_[1] += 4 if defined $res; |
246
|
|
|
|
|
|
|
} else { |
247
|
1
|
|
|
|
|
4
|
$res = unpack('L', $_[0]); |
248
|
|
|
|
|
|
|
} |
249
|
708
|
|
|
|
|
1532
|
return $res; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub unpackF { |
253
|
7
|
|
|
7
|
0
|
9
|
my $res; |
254
|
7
|
50
|
|
|
|
13
|
if (defined $_[1]) { |
255
|
7
|
|
|
|
|
20
|
$res = unpack("x$_[1] f", $_[0]); |
256
|
7
|
50
|
|
|
|
21
|
$_[1] += 4 if defined $res; |
257
|
|
|
|
|
|
|
} else { |
258
|
0
|
|
|
|
|
0
|
$res = unpack('f', $_[0]); |
259
|
|
|
|
|
|
|
} |
260
|
7
|
|
|
|
|
13
|
return $res; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub unpackS { |
264
|
1380
|
|
|
1380
|
0
|
1319
|
my ($res, $len); |
265
|
1380
|
100
|
|
|
|
2025
|
if (defined $_[1]) { |
266
|
1378
|
50
|
|
|
|
8367
|
defined($len = unpack("x$_[1] S", $_[0])) or return; |
267
|
1378
|
50
|
|
|
|
4840
|
defined($res = unpack("x$_[1] x2 a$len", $_[0])) or return; |
268
|
1378
|
50
|
|
|
|
2804
|
length($res) == $len or return; |
269
|
1378
|
|
|
|
|
1463
|
$_[1] += 2; |
270
|
1378
|
|
|
|
|
1651
|
$_[1] += $len; |
271
|
|
|
|
|
|
|
} else { |
272
|
2
|
50
|
|
|
|
8
|
defined($len = unpack('S', $_[0])) or return; |
273
|
2
|
|
|
|
|
8
|
$res = unpack("x2 a$len", $_[0]); |
274
|
|
|
|
|
|
|
} |
275
|
1380
|
|
|
|
|
3378
|
return $res; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub unpackSList { |
279
|
1
|
|
|
1
|
0
|
3
|
my (@res, $len, $s); |
280
|
1
|
|
|
|
|
2
|
@res = (); |
281
|
1
|
50
|
|
|
|
2
|
defined($len = &unpackW) or return; |
282
|
1
|
|
|
|
|
4
|
while ($len--) { |
283
|
2
|
50
|
|
|
|
3
|
defined($s = &unpackS) or return; |
284
|
2
|
|
|
|
|
5
|
push @res, $s; |
285
|
|
|
|
|
|
|
} |
286
|
1
|
|
|
|
|
10
|
return \@res; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub unpackHash8 { |
290
|
1042
|
|
|
1042
|
0
|
3473
|
my $res = unpack("x$_[1] H16", $_[0]); |
291
|
1042
|
50
|
|
|
|
1904
|
length($res) == 16 or return; |
292
|
1042
|
|
|
|
|
1141
|
$_[1] += 8; |
293
|
1042
|
|
|
|
|
3996
|
return $res; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub unpackHash { |
297
|
283
|
|
|
283
|
0
|
878
|
my $res = unpack("x$_[1] H32", $_[0]); |
298
|
283
|
50
|
|
|
|
576
|
length($res) == 32 or return; |
299
|
283
|
|
|
|
|
311
|
$_[1] += 16; |
300
|
283
|
|
|
|
|
797
|
return $res; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
sub unpackHashList { |
304
|
4
|
|
|
4
|
0
|
8
|
my ($n, @res, $hash); |
305
|
4
|
50
|
|
|
|
12
|
defined($n = &unpackW) or return; |
306
|
4
|
|
|
|
|
8
|
@res = (); |
307
|
4
|
|
|
|
|
20
|
while ($n--) { |
308
|
103
|
50
|
|
|
|
126
|
defined($hash = &unpackHash) or return; |
309
|
103
|
|
|
|
|
242
|
push @res, $hash; |
310
|
|
|
|
|
|
|
} |
311
|
4
|
|
|
|
|
30
|
return \@res; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# |
315
|
|
|
|
|
|
|
sub packB { |
316
|
88
|
|
|
88
|
0
|
368
|
return pack('C', shift); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
sub packW { |
319
|
5
|
|
|
5
|
0
|
21
|
return pack('S', shift); |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
sub packD { |
322
|
28
|
|
|
28
|
0
|
115
|
return pack('L', shift); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
sub packF { |
325
|
0
|
|
|
0
|
0
|
0
|
return pack('f', shift); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
sub packS { |
328
|
60
|
|
|
60
|
0
|
289
|
return pack('Sa*', length $_[0], $_[0]); |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
sub packSList { |
331
|
1
|
|
|
1
|
0
|
2
|
my ($l) = @_; |
332
|
1
|
|
|
|
|
2
|
my ($res, $s); |
333
|
1
|
|
|
|
|
4
|
$res = packW(scalar @$l); |
334
|
1
|
|
|
|
|
3
|
foreach $s (@$l) { |
335
|
2
|
|
|
|
|
4
|
$res .= packS($s); |
336
|
|
|
|
|
|
|
} |
337
|
1
|
|
|
|
|
5
|
return $res; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
sub packHash8 { |
340
|
0
|
|
|
0
|
0
|
0
|
return pack('H16', $_[0]); |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
sub packHash { |
343
|
6
|
|
|
6
|
0
|
37
|
return pack('H32', $_[0]); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
sub packHashList { |
346
|
3
|
|
|
3
|
0
|
6
|
my ($l) = @_; |
347
|
3
|
|
|
|
|
4
|
my ($res, $hash); |
348
|
3
|
|
|
|
|
9
|
$res = packW(scalar @$l); |
349
|
3
|
|
|
|
|
9
|
foreach $hash (@$l) { |
350
|
2
|
|
|
|
|
5
|
$res .= packHash($hash); |
351
|
|
|
|
|
|
|
} |
352
|
3
|
|
|
|
|
18
|
return $res; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# Meta Tag |
356
|
|
|
|
|
|
|
sub makeMeta { |
357
|
26
|
|
|
26
|
0
|
198
|
my ($st, $value, $name, $vt) = @_; |
358
|
26
|
50
|
|
|
|
62
|
if ($st) { |
359
|
26
|
100
|
100
|
|
|
254
|
if ($st == TT_NAME || $st == TT_DESCRIPTION |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
360
|
|
|
|
|
|
|
|| $st == TT_TYPE || $st == TT_FORMAT |
361
|
|
|
|
|
|
|
|| $st == TT_TEMPFILE) { |
362
|
11
|
|
|
|
|
20
|
$vt = VT_STRING; |
363
|
|
|
|
|
|
|
} else { |
364
|
15
|
|
|
|
|
19
|
$vt = VT_INTEGER; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
26
|
50
|
|
|
|
47
|
confess "Value type is undefined" unless defined $vt; |
368
|
26
|
50
|
|
|
|
75
|
return {Type => $st, ValType => $vt, Value => $value, |
369
|
|
|
|
|
|
|
Name => $st ? MetaTagName($st) : $name}; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub sameMetaType { |
373
|
18
|
|
|
18
|
0
|
106
|
my ($m1, $m2) = @_; |
374
|
18
|
|
33
|
|
|
236
|
return $m1 && $m2 && $m1->{ValType} == $m2->{ValType} |
375
|
|
|
|
|
|
|
&& ($m1->{Type} |
376
|
|
|
|
|
|
|
? $m1->{Type} == $m2->{Type} |
377
|
|
|
|
|
|
|
: $m1->{Name} eq $m2->{Name}); |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub unpackMetaTagName { |
381
|
828
|
|
|
828
|
0
|
798
|
my ($name, $st, $len); |
382
|
|
|
|
|
|
|
|
383
|
828
|
50
|
|
|
|
1165
|
defined($name = &unpackS) or return; |
384
|
828
|
50
|
|
|
|
1632
|
($len = length $name) or return; # length is not 0 |
385
|
828
|
|
|
|
|
809
|
$st = ord $name; |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
# if ($st < _TT_LAST) { # special tag |
388
|
828
|
100
|
100
|
|
|
3520
|
if ($st == TT_GAPEND || $st == TT_GAPSTART) { |
|
|
100
|
|
|
|
|
|
389
|
10
|
|
|
|
|
26
|
$name = unpack('xa*', $name); |
390
|
|
|
|
|
|
|
} elsif ($len == 1) { |
391
|
716
|
|
|
|
|
1269
|
$name = MetaTagName($st); |
392
|
716
|
100
|
|
|
|
1526
|
$name = sprintf("Unknown(0x%x)", $st) if !$name; |
393
|
|
|
|
|
|
|
} else { |
394
|
102
|
|
|
|
|
123
|
$st = TT_UNDEFINED; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
# } else { |
397
|
|
|
|
|
|
|
# $st = TT_UNDEFINED; |
398
|
|
|
|
|
|
|
# } |
399
|
828
|
|
|
|
|
3371
|
return {Type => $st, Name => $name}; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
sub packMetaTagName { |
402
|
37
|
|
|
37
|
0
|
73
|
my ($meta) = @_; |
403
|
37
|
|
|
|
|
86
|
my ($st, $name) = ($meta->{Type}, $meta->{Name}); |
404
|
|
|
|
|
|
|
|
405
|
37
|
100
|
100
|
|
|
253
|
if ($st == TT_GAPSTART || $st == TT_GAPEND) { |
|
|
50
|
|
|
|
|
|
406
|
2
|
|
|
|
|
11
|
$name = packB($st) . $name; |
407
|
|
|
|
|
|
|
} elsif ($st) { |
408
|
35
|
|
|
|
|
76
|
$name = packB($st); |
409
|
|
|
|
|
|
|
} |
410
|
37
|
|
|
|
|
96
|
return packS($name); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub unpackMeta { |
414
|
825
|
|
|
825
|
0
|
833
|
my ($vt, $val, $meta); |
415
|
|
|
|
|
|
|
|
416
|
825
|
50
|
|
|
|
1179
|
defined($vt = &unpackB) or return; |
417
|
825
|
50
|
|
|
|
1227
|
$meta = &unpackMetaTagName or return; |
418
|
|
|
|
|
|
|
|
419
|
825
|
100
|
|
|
|
1559
|
if ($vt == VT_STRING) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
420
|
546
|
|
|
|
|
780
|
$val = &unpackS; |
421
|
|
|
|
|
|
|
} elsif ($vt == VT_INTEGER) { |
422
|
272
|
|
|
|
|
422
|
$val = &unpackD; |
423
|
|
|
|
|
|
|
} elsif ($vt == VT_FLOAT) { |
424
|
7
|
|
|
|
|
24
|
$val = &unpackF; |
425
|
|
|
|
|
|
|
} else { |
426
|
0
|
|
|
|
|
0
|
return; |
427
|
|
|
|
|
|
|
} |
428
|
825
|
50
|
|
|
|
1727
|
defined($val) or return; |
429
|
|
|
|
|
|
|
|
430
|
825
|
|
|
|
|
1363
|
$meta->{ValType} = $vt; |
431
|
825
|
|
|
|
|
1287
|
$meta->{Value} = $val; |
432
|
825
|
|
|
|
|
2579
|
return $meta; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
sub packMeta { |
435
|
34
|
|
|
34
|
0
|
4842
|
my ($meta) = @_; |
436
|
34
|
|
|
|
|
95
|
my ($vt, $val) = ($meta->{ValType}, $meta->{Value}); |
437
|
34
|
|
|
|
|
84
|
my $res = packB($vt) . packMetaTagName($meta); |
438
|
34
|
100
|
|
|
|
120
|
if ($vt == VT_STRING) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
439
|
17
|
|
|
|
|
34
|
$res .= packS($val); |
440
|
|
|
|
|
|
|
} elsif ($vt == VT_INTEGER) { |
441
|
17
|
|
|
|
|
41
|
$res .= packD($val); |
442
|
|
|
|
|
|
|
} elsif ($vt == VT_FLOAT) { |
443
|
0
|
|
|
|
|
0
|
$res .= packF($val); |
444
|
|
|
|
|
|
|
} else { |
445
|
0
|
|
|
|
|
0
|
confess "Incorrect meta tag value type!\n"; |
446
|
|
|
|
|
|
|
} |
447
|
34
|
|
|
|
|
138
|
return $res; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
sub printMeta { |
450
|
0
|
|
|
0
|
0
|
0
|
my ($m) = @_; |
451
|
0
|
0
|
|
|
|
0
|
print $m->{Name}, ': ', ($m->{Type} == TT_IP ? ip2addr($m->{Value}) : $m->{Value}); |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# list of references to meta tags |
455
|
|
|
|
|
|
|
sub unpackMetaList { |
456
|
143
|
|
|
143
|
0
|
140
|
my ($ntags, @res, $meta); |
457
|
143
|
50
|
|
|
|
4812
|
defined($ntags = &unpackD) or return; |
458
|
143
|
|
|
|
|
217
|
@res = (); |
459
|
143
|
|
|
|
|
273
|
while ($ntags--) { |
460
|
568
|
50
|
|
|
|
800
|
$meta = &unpackMeta or return; |
461
|
568
|
|
|
|
|
1352
|
push @res, $meta; |
462
|
|
|
|
|
|
|
} |
463
|
143
|
|
|
|
|
375
|
return \@res; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
sub packMetaList { |
466
|
4
|
|
|
4
|
0
|
8
|
my ($l) = @_; |
467
|
4
|
|
|
|
|
7
|
my ($res, $meta); |
468
|
4
|
|
|
|
|
13
|
$res = packD(scalar @$l); |
469
|
4
|
|
|
|
|
13
|
foreach $meta (@$l) { |
470
|
16
|
|
|
|
|
36
|
$res .= packMeta($meta); |
471
|
|
|
|
|
|
|
} |
472
|
4
|
|
|
|
|
20
|
return $res; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
sub printMetaList { |
475
|
0
|
|
|
0
|
0
|
0
|
my ($l) = @_; |
476
|
0
|
|
|
|
|
0
|
foreach my $m (@$l) { |
477
|
0
|
|
|
|
|
0
|
print "\t"; |
478
|
0
|
|
|
|
|
0
|
printMeta($m); |
479
|
0
|
|
|
|
|
0
|
print "\n"; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# hash of references to meta |
484
|
|
|
|
|
|
|
sub unpackMetaListU { |
485
|
71
|
|
|
71
|
0
|
72
|
my ($ntags, %res, $meta); |
486
|
|
|
|
|
|
|
|
487
|
71
|
|
|
|
|
273
|
tie %res, "Tie::IxHash"; |
488
|
71
|
50
|
|
|
|
948
|
defined($ntags = &unpackD) or return; |
489
|
71
|
|
|
|
|
233
|
%res = (); |
490
|
71
|
|
|
|
|
1146
|
while ($ntags--) { |
491
|
239
|
50
|
|
|
|
2847
|
$meta = &unpackMeta or return; |
492
|
239
|
|
|
|
|
1305
|
$res{$meta->{Name}} = $meta; |
493
|
|
|
|
|
|
|
} |
494
|
71
|
|
|
|
|
1178
|
return \%res; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
sub packMetaListU { |
497
|
0
|
|
|
0
|
0
|
0
|
my ($res, $meta); |
498
|
0
|
|
|
|
|
0
|
my $ntags = 0; |
499
|
0
|
|
|
|
|
0
|
$res = ''; |
500
|
0
|
|
|
|
|
0
|
while ((undef, $meta) = each %{$_[0]}) { |
|
0
|
|
|
|
|
0
|
|
501
|
0
|
|
|
|
|
0
|
$res .= packMeta($meta); |
502
|
0
|
|
|
|
|
0
|
$ntags++; |
503
|
|
|
|
|
|
|
} |
504
|
0
|
|
|
|
|
0
|
return packD($ntags) . $res; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
sub printMetaListU { |
507
|
0
|
|
|
0
|
0
|
0
|
my ($l) = @_; |
508
|
0
|
|
|
|
|
0
|
foreach my $m (values %$l) { |
509
|
0
|
|
|
|
|
0
|
print "\t"; |
510
|
0
|
|
|
|
|
0
|
printMeta($m); |
511
|
0
|
|
|
|
|
0
|
print "\n"; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
sub MetaList2MetaListU { |
516
|
0
|
|
|
0
|
0
|
0
|
my ($l) = @_; |
517
|
0
|
|
|
|
|
0
|
my %res; |
518
|
0
|
|
|
|
|
0
|
tie %res, "Tie::IxHash"; |
519
|
0
|
|
|
|
|
0
|
foreach my $meta (@$l) { |
520
|
0
|
|
|
|
|
0
|
$res{$meta->{Name}} = $meta; |
521
|
|
|
|
|
|
|
} |
522
|
0
|
|
|
|
|
0
|
return \%res; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
sub MetaListU2MetaList { |
526
|
4
|
|
|
4
|
0
|
8
|
return [values %{$_[0]}]; |
|
4
|
|
|
|
|
27
|
|
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# client, server or search result info |
530
|
|
|
|
|
|
|
sub unpackInfo { |
531
|
0
|
|
|
0
|
0
|
0
|
my ($hash, $ip, $port, $meta); |
532
|
0
|
0
|
|
|
|
0
|
defined($hash = &unpackHash) or return; |
533
|
0
|
0
|
|
|
|
0
|
($ip, $port) = &unpackAddr or return; |
534
|
0
|
0
|
|
|
|
0
|
$meta = &unpackMetaListU or return; |
535
|
0
|
|
|
|
|
0
|
return {Hash => $hash, IP => $ip, Port => $port, Meta => $meta}; |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
sub packInfo { |
539
|
0
|
|
|
0
|
0
|
0
|
my ($d) = @_; |
540
|
0
|
|
|
|
|
0
|
return packHash($d->{Hash}) . packAddr($d) |
541
|
|
|
|
|
|
|
. packMetaListU($d->{Meta}); |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
sub unpackInfoList { |
545
|
0
|
|
|
0
|
0
|
0
|
my ($nres, @res, $info); |
546
|
0
|
0
|
|
|
|
0
|
defined($nres = &unpackD) or return; |
547
|
0
|
|
|
|
|
0
|
@res = (); |
548
|
0
|
|
|
|
|
0
|
while ($nres--) { |
549
|
0
|
0
|
|
|
|
0
|
$info = &unpackInfo or return; |
550
|
0
|
|
|
|
|
0
|
push @res, $info; |
551
|
|
|
|
|
|
|
} |
552
|
0
|
|
|
|
|
0
|
return \@res; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
sub packInfoList { |
556
|
0
|
|
|
0
|
0
|
0
|
my ($l) = @_; |
557
|
0
|
|
|
|
|
0
|
my ($res, $info); |
558
|
0
|
|
|
|
|
0
|
$res = packD(scalar @$l); |
559
|
0
|
|
|
|
|
0
|
foreach $info (@$l) { |
560
|
0
|
|
|
|
|
0
|
$res .= packInfo($info); |
561
|
|
|
|
|
|
|
} |
562
|
0
|
|
|
|
|
0
|
return $res; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
sub printInfoList { |
566
|
0
|
|
|
0
|
0
|
0
|
foreach my $i (@{$_[0]}) { |
|
0
|
|
|
|
|
0
|
|
567
|
0
|
|
|
|
|
0
|
printInfo($i); |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
sub makeClientInfo { |
572
|
0
|
|
|
0
|
0
|
0
|
my ($ip, $port, $nick, $version) = @_; |
573
|
0
|
|
|
|
|
0
|
my (%meta, $hash);; |
574
|
0
|
|
|
|
|
0
|
$hash = md4_hex($nick); |
575
|
0
|
|
|
|
|
0
|
tie %meta, "Tie::IxHash"; |
576
|
0
|
|
|
|
|
0
|
$meta{Name} = makeMeta(TT_NAME, $nick); |
577
|
0
|
|
|
|
|
0
|
$meta{Version} = makeMeta(TT_VERSION, $version); |
578
|
0
|
|
|
|
|
0
|
$meta{Port} = makeMeta(TT_PORT, $port); |
579
|
0
|
|
|
|
|
0
|
return {Hash => $hash, IP => $ip, Port => $port, Meta => \%meta}; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
sub makeServerInfo { |
583
|
0
|
|
|
0
|
0
|
0
|
my ($ip, $port, $name, $description) = @_; |
584
|
0
|
|
|
|
|
0
|
my (%meta, $hash);; |
585
|
0
|
|
|
|
|
0
|
$hash = md4_hex($name); |
586
|
0
|
|
|
|
|
0
|
tie %meta, "Tie::IxHash"; |
587
|
0
|
|
|
|
|
0
|
$meta{Name} = makeMeta(TT_NAME, $name); |
588
|
0
|
|
|
|
|
0
|
$meta{Description} = makeMeta(TT_DESCRIPTION, $description); |
589
|
0
|
|
|
|
|
0
|
return {Hash => $hash, IP => $ip, Port => $port, Meta => \%meta}; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
sub printInfo { |
593
|
0
|
|
|
0
|
0
|
0
|
my ($info) = @_; |
594
|
0
|
0
|
|
|
|
0
|
$info or return; |
595
|
|
|
|
|
|
|
|
596
|
0
|
0
|
|
|
|
0
|
if (defined $info->{Date}) { |
597
|
0
|
|
|
|
|
0
|
print "Date: ", scalar(localtime($info->{Date})), "\n"; |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
0
|
0
|
|
|
|
0
|
if (defined $info->{IP}) { |
601
|
0
|
|
|
|
|
0
|
print "Address: "; |
602
|
0
|
|
|
|
|
0
|
printAddr($info); |
603
|
0
|
|
|
|
|
0
|
print "\n"; |
604
|
|
|
|
|
|
|
} |
605
|
|
|
|
|
|
|
|
606
|
0
|
0
|
|
|
|
0
|
if (defined $info->{Hash}) { |
607
|
0
|
|
|
|
|
0
|
print "Hash: $info->{Hash}\n"; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
0
|
0
|
|
|
|
0
|
if ($info->{Parts}) { |
611
|
0
|
|
|
|
|
0
|
print "Parts:\n"; |
612
|
0
|
|
|
|
|
0
|
my $i = 0; |
613
|
0
|
|
|
|
|
0
|
foreach my $parthash (@{$info->{Parts}}) { |
|
0
|
|
|
|
|
0
|
|
614
|
0
|
|
|
|
|
0
|
print "\t$i: $parthash\n"; |
615
|
0
|
|
|
|
|
0
|
$i++; |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
0
|
0
|
|
|
|
0
|
if ($info->{Parts8}) { |
620
|
0
|
|
|
|
|
0
|
print "Parts8:\n"; |
621
|
0
|
|
|
|
|
0
|
my $i = 0; |
622
|
0
|
|
|
|
|
0
|
foreach my $parthash (@{$info->{Parts8}}) { |
|
0
|
|
|
|
|
0
|
|
623
|
0
|
|
|
|
|
0
|
print "\t$i: $parthash\n"; |
624
|
0
|
|
|
|
|
0
|
$i++; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
0
|
0
|
|
|
|
0
|
if ($info->{Gaps}) { |
629
|
0
|
|
|
|
|
0
|
print "Gaps:\n"; |
630
|
0
|
|
|
|
|
0
|
my $gaps = $info->{Gaps}; |
631
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < @$gaps/2; $i += 2) { |
632
|
0
|
|
|
|
|
0
|
print "\t$gaps->[$i] - $gaps->[$i+1]\n"; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
|
636
|
0
|
0
|
|
|
|
0
|
if ($info->{Meta}) { |
637
|
0
|
|
|
|
|
0
|
my ($name, $meta); |
638
|
0
|
|
|
|
|
0
|
print "Meta:\n"; |
639
|
0
|
|
|
|
|
0
|
while (($name, $meta) = each %{$info->{Meta}}) { |
|
0
|
|
|
|
|
0
|
|
640
|
0
|
|
|
|
|
0
|
print "\t$name: $meta->{Value}\n"; |
641
|
|
|
|
|
|
|
} |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
# file info |
646
|
|
|
|
|
|
|
sub unpackFileInfo { |
647
|
140
|
|
|
140
|
0
|
162
|
my (%res, $metas, %tags, @gaps); |
648
|
0
|
|
|
|
|
0
|
my $bb; |
649
|
|
|
|
|
|
|
|
650
|
140
|
|
|
|
|
195
|
$bb = &unpackB; |
651
|
140
|
50
|
|
|
|
254
|
($bb == FI_DESCRIPTION) or return; |
652
|
|
|
|
|
|
|
|
653
|
140
|
50
|
|
|
|
184
|
defined($res{Date} = &unpackD) or return; |
654
|
140
|
50
|
|
|
|
239
|
defined($res{Hash} = &unpackHash) or return; |
655
|
140
|
50
|
|
|
|
246
|
$metas = &unpackMetaList or return; |
656
|
|
|
|
|
|
|
|
657
|
140
|
|
|
|
|
628
|
tie %tags, "Tie::IxHash"; |
658
|
140
|
|
|
|
|
1758
|
foreach my $meta (@$metas) { |
659
|
546
|
100
|
100
|
|
|
6448
|
if ($meta->{Type} == TT_GAPSTART || $meta->{Type} == TT_GAPEND) { |
660
|
2
|
|
|
|
|
6
|
push @gaps, $meta->{Value}; |
661
|
|
|
|
|
|
|
} else { |
662
|
544
|
|
|
|
|
2247
|
$tags{$meta->{Name}} = $meta; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
} |
665
|
140
|
|
|
|
|
1855
|
$res{Gaps} = [sort {$a <=> $b} @gaps]; |
|
1
|
|
|
|
|
6
|
|
666
|
140
|
|
|
|
|
242
|
$res{Meta} = \%tags; |
667
|
|
|
|
|
|
|
|
668
|
140
|
|
|
|
|
223
|
$bb = &unpackB; |
669
|
140
|
100
|
|
|
|
329
|
if ($bb == FI_PART_HASHES) { |
|
|
100
|
|
|
|
|
|
670
|
67
|
|
|
|
|
280
|
my $size = $tags{Size}{Value}; |
671
|
67
|
100
|
|
|
|
528
|
if ($size >= SZ_B_FILEPART) { |
672
|
9
|
|
|
|
|
13
|
my @hashes; |
673
|
9
|
|
|
|
|
60
|
for (my $i = 0; $i < ceil($size / SZ_B_FILEPART); $i++) { |
674
|
36
|
|
|
|
|
56
|
push @hashes, &unpackHash; |
675
|
|
|
|
|
|
|
} |
676
|
9
|
|
|
|
|
20
|
$res{Parts} = \@hashes; |
677
|
9
|
50
|
|
|
|
18
|
(&unpackB == FI_PART_HASHES) or return; |
678
|
|
|
|
|
|
|
} |
679
|
67
|
50
|
|
|
|
122
|
if ($size >= SZ_S_FILEPART) { |
680
|
67
|
|
|
|
|
73
|
my @hashes8; |
681
|
67
|
|
|
|
|
315
|
for (my $i = 0; $i < ceil($size / SZ_S_FILEPART); $i++) { |
682
|
1042
|
|
|
|
|
1575
|
push @hashes8, &unpackHash8; |
683
|
|
|
|
|
|
|
} |
684
|
67
|
|
|
|
|
167
|
$res{Parts8} = \@hashes8; |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
} elsif ($bb == FI_DESCRIPTION) { |
687
|
71
|
50
|
|
|
|
264
|
if (defined $_[1]) { |
688
|
71
|
|
|
|
|
94
|
$_[1] -= 1; |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
140
|
|
|
|
|
562
|
return \%res; |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
sub packFileInfo { |
696
|
2
|
|
|
2
|
0
|
11
|
my ($d) = @_; |
697
|
2
|
|
|
|
|
3
|
my ($res, $metas); |
698
|
2
|
|
|
|
|
8
|
$res = packB(FI_DESCRIPTION) . packD($d->{Date}) . packHash($d->{Hash}); |
699
|
2
|
|
|
|
|
11
|
$metas = MetaListU2MetaList($d->{Meta}); |
700
|
2
|
50
|
66
|
|
|
170
|
if ($d->{Gaps} and @{$d->{Gaps}}) { |
|
1
|
|
|
|
|
9
|
|
701
|
0
|
|
|
|
|
0
|
my $gaps = $d->{Gaps}; |
702
|
0
|
|
|
|
|
0
|
my $ngaps = @$gaps / 2; |
703
|
0
|
|
|
|
|
0
|
for (my ($i, $n) = (0, 0); $i < $ngaps; $i += 2, $n++) { |
704
|
0
|
|
|
|
|
0
|
push @$metas, makeMeta(TT_GAPSTART, $gaps->[$i], $n); |
705
|
|
|
|
|
|
|
} |
706
|
0
|
|
|
|
|
0
|
for (my ($i, $n) = (0, 0); $i < $ngaps; $i += 2, $n++) { |
707
|
0
|
|
|
|
|
0
|
push @$metas, makeMeta(TT_GAPEND, $gaps->[$i+1], $i); |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
} |
710
|
2
|
|
|
|
|
10
|
$res .= packMetaList($metas); |
711
|
2
|
50
|
66
|
|
|
13
|
if ($d->{Parts} and @{$d->{Parts}}) { |
|
1
|
|
|
|
|
10
|
|
712
|
0
|
|
|
|
|
0
|
$res .= packB(FI_PART_HASHES); |
713
|
0
|
|
|
|
|
0
|
foreach my $h ($d->{Parts}) { |
714
|
0
|
|
|
|
|
0
|
$res .= packHash($h); |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
} |
717
|
2
|
50
|
66
|
|
|
13
|
if ($d->{Parts8} and @{$d->{Parts8}}) { |
|
1
|
|
|
|
|
10
|
|
718
|
0
|
|
|
|
|
0
|
$res .= packB(FI_PART_HASHES); |
719
|
0
|
|
|
|
|
0
|
foreach my $h8 ($d->{Parts8}) { |
720
|
0
|
|
|
|
|
0
|
$res .= packHash8($h8); |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
} |
723
|
2
|
|
|
|
|
8
|
$res .= packB(0x0); |
724
|
2
|
|
|
|
|
12
|
return $res; |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub unpackFileInfoList { |
728
|
1
|
|
|
1
|
0
|
22
|
my ($nres, @res, $info); |
729
|
1
|
50
|
|
|
|
4
|
defined($nres = &unpackD) or return; |
730
|
1
|
|
|
|
|
3
|
@res = (); |
731
|
1
|
|
|
|
|
5
|
while ($nres--) { |
732
|
138
|
50
|
|
|
|
208
|
$info = &unpackFileInfo or return; |
733
|
138
|
|
|
|
|
402
|
push @res, $info; |
734
|
|
|
|
|
|
|
} |
735
|
1
|
|
|
|
|
6
|
return \@res; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
sub packFileInfoList { |
739
|
0
|
|
|
0
|
0
|
0
|
my ($l) = @_; |
740
|
0
|
|
|
|
|
0
|
my ($res, $info); |
741
|
0
|
|
|
|
|
0
|
$res = packD(scalar @$l);; |
742
|
0
|
|
|
|
|
0
|
foreach $info (@$l) { |
743
|
0
|
|
|
|
|
0
|
$res .= packFileInfo($info); |
744
|
|
|
|
|
|
|
} |
745
|
0
|
|
|
|
|
0
|
return $res; |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
sub makeFileInfo { |
749
|
1
|
|
|
1
|
0
|
323
|
my ($path) = @_; |
750
|
1
|
|
|
|
|
3
|
my ($base, $ext); |
751
|
0
|
|
|
|
|
0
|
my ($context, %meta, $hash, $type); |
752
|
|
|
|
|
|
|
|
753
|
1
|
|
|
|
|
83
|
$path = bsd_glob($path, GLOB_TILDE); |
754
|
|
|
|
|
|
|
|
755
|
1
|
50
|
33
|
|
|
35
|
(-e $path && -r _) or return; |
756
|
|
|
|
|
|
|
|
757
|
1
|
50
|
|
|
|
6
|
print "Making info for $path\n" if $debug; |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
# my $vinfo = Video::Info->new(-file => $path); |
760
|
|
|
|
|
|
|
# if ($vinfo->type()) { |
761
|
|
|
|
|
|
|
# print $vinfo->filename, "\n"; |
762
|
|
|
|
|
|
|
# print $vinfo->filesize(), "\n"; |
763
|
|
|
|
|
|
|
# print $vinfo->type(), "\n"; |
764
|
|
|
|
|
|
|
# print $vinfo->duration(), "\n"; |
765
|
|
|
|
|
|
|
# print $vinfo->minutes(), "\n"; |
766
|
|
|
|
|
|
|
# print $vinfo->MMSS(), "\n"; |
767
|
|
|
|
|
|
|
# print $vinfo->geometry(), "\n"; |
768
|
|
|
|
|
|
|
# print $vinfo->title(), "\n"; |
769
|
|
|
|
|
|
|
# print $vinfo->author(), "\n"; |
770
|
|
|
|
|
|
|
# print $vinfo->copyright(), "\n"; |
771
|
|
|
|
|
|
|
# print $vinfo->description(), "\n"; |
772
|
|
|
|
|
|
|
# print $vinfo->rating(), "\n"; |
773
|
|
|
|
|
|
|
# print $vinfo->packets(), "\n"; |
774
|
|
|
|
|
|
|
# } |
775
|
|
|
|
|
|
|
|
776
|
1
|
|
|
|
|
93
|
($base, undef, $ext) = fileparse($path, '\..*'); |
777
|
1
|
50
|
|
|
|
9
|
$ext = unpack('xa*', $ext) if $ext; # skip first '.' |
778
|
1
|
50
|
|
|
|
5
|
if ($ext) { |
779
|
1
|
|
|
|
|
9
|
my %ft = qw(mp3 Audio avi Video gif Image iso Pro doc Doc); |
780
|
1
|
|
|
|
|
10
|
$type = $ft{lc $ext}; |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
1
|
|
|
|
|
3
|
my ($size, $date); |
784
|
1
|
|
|
|
|
29
|
$size = (stat _)[7]; |
785
|
1
|
|
|
|
|
5
|
$date = (stat _)[9]; |
786
|
|
|
|
|
|
|
|
787
|
1
|
|
|
|
|
15
|
tie %meta, "Tie::IxHash"; |
788
|
1
|
|
|
|
|
34
|
$meta{Name} = makeMeta(TT_NAME, "$base.$ext"); |
789
|
1
|
|
|
|
|
38
|
$meta{Size} = makeMeta(TT_SIZE, $size); |
790
|
1
|
50
|
|
|
|
28
|
$meta{Type} = makeMeta(TT_TYPE, $type) if $type; |
791
|
1
|
50
|
|
|
|
28
|
$meta{Format} = makeMeta(TT_FORMAT, $ext) if $ext; |
792
|
|
|
|
|
|
|
|
793
|
1
|
50
|
|
|
|
87
|
open(HANDLE, $path) or return; |
794
|
1
|
|
|
|
|
7
|
binmode(HANDLE); |
795
|
|
|
|
|
|
|
|
796
|
1
|
|
|
|
|
26
|
$context = new Digest::MD4; |
797
|
1
|
|
|
|
|
82
|
$context->addfile(\*HANDLE); |
798
|
1
|
|
|
|
|
11
|
$hash = $context->hexdigest; |
799
|
|
|
|
|
|
|
|
800
|
1
|
|
|
|
|
3
|
my $part; |
801
|
1
|
|
|
|
|
4
|
my @parts = (); |
802
|
1
|
50
|
|
|
|
7
|
if ($size > SZ_B_FILEPART) { |
803
|
0
|
|
|
|
|
0
|
seek(HANDLE, 0, 0); |
804
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < ceil($size / SZ_B_FILEPART); $i++) { |
805
|
0
|
|
|
|
|
0
|
read(HANDLE, $part, SZ_B_FILEPART); |
806
|
0
|
|
|
|
|
0
|
push @parts, md4_hex($part); |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
} |
809
|
1
|
|
|
|
|
3
|
my @parts8 = (); |
810
|
1
|
50
|
|
|
|
7
|
if ($size >= SZ_S_FILEPART) { |
811
|
0
|
|
|
|
|
0
|
seek(HANDLE, 0, 0); |
812
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < ceil($size / SZ_S_FILEPART); $i++) { |
813
|
0
|
|
|
|
|
0
|
read(HANDLE, $part, SZ_S_FILEPART); |
814
|
0
|
|
|
|
|
0
|
push @parts8, substr(md4_hex($part), 0, 16); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
1
|
|
|
|
|
54
|
close HANDLE; |
819
|
|
|
|
|
|
|
|
820
|
1
|
|
|
|
|
21
|
return {Date => $date, Hash => $hash, Parts => \@parts, Parts8 => \@parts8, Meta => \%meta, Path => $path}; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
sub makeFileInfoList { |
824
|
0
|
|
|
0
|
0
|
0
|
my (@res, $info); |
825
|
0
|
|
|
|
|
0
|
@res = (); |
826
|
0
|
|
|
|
|
0
|
foreach my $pattern (@_) { |
827
|
0
|
|
|
|
|
0
|
my $globbed = bsd_glob($pattern, GLOB_TILDE); |
828
|
0
|
|
|
|
|
0
|
print "ggg: $globbed\n"; |
829
|
0
|
0
|
|
0
|
|
0
|
find { wanted => sub { push(@res, makeFileInfo($File::Find::name)) if -f $File::Find::name}, no_chdir => 1 }, |
|
0
|
|
|
|
|
0
|
|
830
|
|
|
|
|
|
|
bsd_glob($pattern, GLOB_TILDE); |
831
|
|
|
|
|
|
|
} |
832
|
0
|
|
|
|
|
0
|
return \@res; |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
# search query |
836
|
|
|
|
|
|
|
sub unpackSearchQuery { |
837
|
7
|
|
|
7
|
0
|
14
|
my ($t); |
838
|
7
|
50
|
|
|
|
19
|
defined($t = &unpackB) or return; |
839
|
|
|
|
|
|
|
|
840
|
7
|
100
|
|
|
|
37
|
if ($t == ST_COMBINE) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
841
|
3
|
|
|
|
|
6
|
my ($op, $exp1, $exp2); |
842
|
3
|
50
|
|
|
|
9
|
defined($op = &unpackB) or return; |
843
|
3
|
50
|
|
|
|
25
|
$exp1 = &unpackSearchQuery or return; |
844
|
3
|
50
|
|
|
|
9
|
$exp2 = &unpackSearchQuery or return; |
845
|
3
|
|
|
|
|
23
|
return {Type => $t, Op => $op, Q1 => $exp1, Q2 => $exp2}; |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
} elsif ($t == ST_NAME) { |
848
|
1
|
|
|
|
|
3
|
my $str; |
849
|
1
|
50
|
|
|
|
4
|
defined($str = &unpackS) or return; |
850
|
1
|
|
|
|
|
29
|
return {Type => $t, Value => $str}; |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
} elsif ($t == ST_META) { |
853
|
1
|
|
|
|
|
2
|
my ($val, $metaname); |
854
|
1
|
50
|
|
|
|
4
|
defined($val = &unpackS) or return; |
855
|
1
|
50
|
|
|
|
11
|
$metaname = &unpackMetaTagName or return; |
856
|
1
|
|
|
|
|
9
|
return {Type => $t, Value => $val, MetaName => $metaname}; |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
} elsif ($t == ST_MINMAX) { |
859
|
2
|
|
|
|
|
5
|
my ($val, $metaname, $comp); |
860
|
2
|
50
|
|
|
|
8
|
defined($val = &unpackD) or return; |
861
|
2
|
50
|
|
|
|
5
|
defined($comp = &unpackB) or return; |
862
|
2
|
50
|
66
|
|
|
23
|
($comp == ST_MIN || $comp == ST_MAX) or return; |
863
|
2
|
50
|
|
|
|
190
|
$metaname = &unpackMetaTagName or return; |
864
|
2
|
|
|
|
|
15
|
return {Type => $t, Value => $val, Compare => $comp, MetaName => $metaname}; |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
} else { |
867
|
0
|
|
|
|
|
0
|
return; |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
sub packSearchQuery { |
871
|
7
|
|
|
7
|
0
|
316
|
my ($d) = @_; |
872
|
7
|
|
|
|
|
11
|
my ($res, $t); |
873
|
7
|
|
|
|
|
23
|
$res = packB($t = $d->{Type}); |
874
|
|
|
|
|
|
|
|
875
|
7
|
100
|
|
|
|
49
|
if ($t == ST_COMBINE) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
876
|
3
|
|
|
|
|
11
|
return $res . packB($d->{Op}) |
877
|
|
|
|
|
|
|
. packSearchQuery($d->{Q1}) |
878
|
|
|
|
|
|
|
. packSearchQuery($d->{Q2}); |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
} elsif ($t == ST_NAME) { |
881
|
1
|
|
|
|
|
4
|
return $res . packS($d->{Value}); |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
} elsif ($t == ST_META) { |
884
|
1
|
|
|
|
|
5
|
return $res . packS($d->{Value}) . packMetaTagName($d->{MetaName}); |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
} elsif ($t == ST_MINMAX) { |
887
|
2
|
|
|
|
|
9
|
return $res . packD($d->{Value}) . packB($d->{Compare}) |
888
|
|
|
|
|
|
|
. packMetaTagName($d->{MetaName}); |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
} else { |
891
|
0
|
|
|
|
|
0
|
confess "Incorrect search query type!\n"; |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
sub makeSQLExpr { |
896
|
14
|
|
|
14
|
0
|
48
|
my ($q, $ok, $fields) = @_; |
897
|
14
|
|
|
|
|
29
|
my $t = $q->{Type}; |
898
|
14
|
|
|
|
|
25
|
my $nm; |
899
|
|
|
|
|
|
|
|
900
|
14
|
100
|
|
|
|
57
|
if ($t == ST_COMBINE) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
901
|
6
|
|
|
|
|
14
|
my $op = $q->{Op}; |
902
|
|
|
|
|
|
|
|
903
|
6
|
100
|
|
|
|
27
|
if ($op == ST_AND) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
904
|
2
|
|
|
|
|
45
|
return makeSQLExpr($q->{Q1}, $ok, $fields) . ' AND ' . makeSQLExpr($q->{Q2}, $ok, $fields); |
905
|
|
|
|
|
|
|
} elsif ($op == ST_OR) { |
906
|
2
|
|
|
|
|
24
|
return '(' . makeSQLExpr($q->{Q1}, $ok, $fields) . ' OR ' . makeSQLExpr($q->{Q2}, $ok, $fields) . ')'; |
907
|
|
|
|
|
|
|
} elsif ($op == ST_ANDNOT) { |
908
|
2
|
|
|
|
|
8
|
return makeSQLExpr($q->{Q1}, $ok, $fields) . ' AND NOT ' . makeSQLExpr($q->{Q2}, $ok, $fields); |
909
|
|
|
|
|
|
|
} else { |
910
|
0
|
|
|
|
|
0
|
$$ok = 0; |
911
|
0
|
|
|
|
|
0
|
return ''; |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
} elsif ($t == ST_NAME) { |
915
|
2
|
|
|
|
|
6
|
my $nm = MetaTagName(TT_NAME); |
916
|
2
|
|
|
|
|
7
|
my $ft = $fields->{$nm}; |
917
|
2
|
50
|
33
|
|
|
17
|
if (defined $ft && $ft == VT_STRING) { |
918
|
2
|
|
|
|
|
6
|
my $qval = $q->{Value}; |
919
|
2
|
|
|
|
|
7
|
$qval =~ s/'/''/g; |
920
|
2
|
|
|
|
|
17
|
return "$nm LIKE '$qval'"; |
921
|
|
|
|
|
|
|
} else { |
922
|
0
|
|
|
|
|
0
|
$$ok = 0; |
923
|
0
|
|
|
|
|
0
|
return ''; |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
} elsif ($t == ST_META) { |
927
|
2
|
|
|
|
|
7
|
my $nm = $q->{MetaName}->{Name}; |
928
|
2
|
|
|
|
|
7
|
my $ft = $fields->{$nm}; |
929
|
2
|
50
|
33
|
|
|
15
|
if (defined $ft && $ft == VT_STRING) { |
930
|
2
|
|
|
|
|
5
|
my $qval = $q->{Value}; |
931
|
2
|
|
|
|
|
6
|
$qval =~ s/'/''/g; |
932
|
2
|
|
|
|
|
19
|
return "$nm LIKE '$qval'"; |
933
|
|
|
|
|
|
|
} else { |
934
|
0
|
|
|
|
|
0
|
$$ok = 0; |
935
|
0
|
|
|
|
|
0
|
return ''; |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
} elsif ($t == ST_MINMAX) { |
939
|
4
|
|
|
|
|
12
|
my $nm = $q->{MetaName}->{Name}; |
940
|
4
|
|
|
|
|
9
|
my $ft = $fields->{$nm}; |
941
|
4
|
50
|
33
|
|
|
39
|
if (defined $ft && $ft == VT_INTEGER) { |
942
|
4
|
100
|
|
|
|
19
|
if ($q->{Compare} == ST_MIN) { |
|
|
50
|
|
|
|
|
|
943
|
2
|
|
|
|
|
22
|
return "$nm >= $q->{Value}"; |
944
|
|
|
|
|
|
|
} elsif ($q->{Compare} == ST_MAX) { |
945
|
2
|
|
|
|
|
21
|
return "$nm <= $q->{Value}"; |
946
|
|
|
|
|
|
|
} else { |
947
|
0
|
|
|
|
|
0
|
$$ok = 0; |
948
|
0
|
|
|
|
|
0
|
return ''; |
949
|
|
|
|
|
|
|
} |
950
|
|
|
|
|
|
|
} else { |
951
|
0
|
|
|
|
|
0
|
$$ok = 0; |
952
|
0
|
|
|
|
|
0
|
return ''; |
953
|
|
|
|
|
|
|
} |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
} else { |
956
|
0
|
|
|
|
|
0
|
$$ok = 0; |
957
|
0
|
|
|
|
|
0
|
return ''; |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
sub matchSearchQuery { |
962
|
0
|
|
|
0
|
0
|
0
|
my ($q, $i) = @_; |
963
|
0
|
|
|
|
|
0
|
my $t = $q->{Type}; |
964
|
|
|
|
|
|
|
|
965
|
0
|
0
|
|
|
|
0
|
if ($t == ST_COMBINE) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
966
|
0
|
|
|
|
|
0
|
my $op = $q->{Op}; |
967
|
|
|
|
|
|
|
|
968
|
0
|
0
|
|
|
|
0
|
if ($op == ST_AND) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
969
|
0
|
|
0
|
|
|
0
|
return matchSearchQuery($q->{Q1}, $i) && matchSearchQuery($q->{Q2}, $i); |
970
|
|
|
|
|
|
|
} elsif ($op == ST_OR) { |
971
|
0
|
|
0
|
|
|
0
|
return matchSearchQuery($q->{Q1}, $i) || matchSearchQuery($q->{Q2}, $i); |
972
|
|
|
|
|
|
|
} elsif ($op == ST_ANDNOT) { |
973
|
0
|
|
0
|
|
|
0
|
return matchSearchQuery($q->{Q1}, $i) && !matchSearchQuery($q->{Q2}, $i); |
974
|
|
|
|
|
|
|
} else { |
975
|
0
|
|
|
|
|
0
|
return; |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
} elsif ($t == ST_NAME) { |
979
|
0
|
|
|
|
|
0
|
my ($mm, $qval); |
980
|
0
|
|
|
|
|
0
|
$qval = $q->{Value}; |
981
|
0
|
|
|
|
|
0
|
$mm = $i->{Meta}->{Name}; |
982
|
|
|
|
|
|
|
|
983
|
0
|
|
0
|
|
|
0
|
return ($mm && $mm->{Value} =~ /$qval/); |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
} elsif ($t == ST_META) { |
986
|
0
|
|
|
|
|
0
|
my $mm = $i->{Meta}->{$q->{MetaName}->{Name}}; |
987
|
|
|
|
|
|
|
|
988
|
0
|
0
|
0
|
|
|
0
|
return unless $mm && $mm->{ValType} == VT_STRING; |
989
|
|
|
|
|
|
|
|
990
|
0
|
|
|
|
|
0
|
return $mm->{Value} eq $q->{Value}; |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
} elsif ($t == ST_MINMAX) { |
993
|
0
|
|
|
|
|
0
|
my $mm = $i->{Meta}->{$q->{MetaName}->{Name}}; |
994
|
|
|
|
|
|
|
|
995
|
0
|
0
|
0
|
|
|
0
|
return unless $mm && $mm->{ValType} == VT_INTEGER; |
996
|
|
|
|
|
|
|
|
997
|
0
|
0
|
|
|
|
0
|
if ($q->{Compare} == ST_MIN) { |
|
|
0
|
|
|
|
|
|
998
|
0
|
|
|
|
|
0
|
return $mm->{Value} >= $q->{Value}; |
999
|
|
|
|
|
|
|
} elsif ($q->{Compare} == ST_MAX) { |
1000
|
0
|
|
|
|
|
0
|
return $mm->{Value} <= $q->{Value}; |
1001
|
|
|
|
|
|
|
} else { |
1002
|
0
|
|
|
|
|
0
|
return; |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
} else { |
1006
|
0
|
|
|
|
|
0
|
return; |
1007
|
|
|
|
|
|
|
} |
1008
|
|
|
|
|
|
|
} |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
# list (ip1 port1 ip2 port2 ..) |
1011
|
|
|
|
|
|
|
sub unpackAddrList { |
1012
|
1
|
|
|
1
|
0
|
2
|
my ($snum, $ip, $port, @res); |
1013
|
|
|
|
|
|
|
|
1014
|
1
|
50
|
|
|
|
4
|
defined($snum = &unpackB) or return; |
1015
|
1
|
|
|
|
|
2
|
@res = (); |
1016
|
1
|
|
|
|
|
4
|
while ($snum--) { |
1017
|
2
|
50
|
|
|
|
13
|
defined($ip = &unpackD) or return; |
1018
|
2
|
50
|
|
|
|
4
|
defined($port = &unpackW) or return; |
1019
|
2
|
|
|
|
|
7
|
push @res, $ip, $port; |
1020
|
|
|
|
|
|
|
} |
1021
|
1
|
|
|
|
|
11
|
return \@res; |
1022
|
|
|
|
|
|
|
} |
1023
|
|
|
|
|
|
|
sub packAddrList { |
1024
|
1
|
|
|
1
|
0
|
3
|
my $l = shift; |
1025
|
1
|
|
|
|
|
3
|
my $n = @$l / 2; |
1026
|
1
|
|
|
|
|
13
|
return pack('C', $n) . pack('LS' x $n, @$l); |
1027
|
|
|
|
|
|
|
} |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
sub unpackAddr { |
1030
|
71
|
|
|
71
|
0
|
79
|
my ($ip, $port); |
1031
|
71
|
50
|
|
|
|
98
|
defined($ip = &unpackD) or return; |
1032
|
71
|
50
|
|
|
|
105
|
defined($port = &unpackW) or return; |
1033
|
71
|
|
|
|
|
253
|
return ($ip, $port); |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
sub packAddr { |
1037
|
1
|
|
|
1
|
0
|
3
|
my ($p) = @_; |
1038
|
1
|
50
|
|
|
|
5
|
if (ref $p) { |
1039
|
0
|
|
|
|
|
0
|
return pack('LS', $p->{IP}, $p->{Port}); |
1040
|
|
|
|
|
|
|
} else { |
1041
|
1
|
|
|
|
|
6
|
return pack('LS', @_); |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
} |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
sub printAddr { |
1046
|
0
|
|
|
0
|
0
|
0
|
my ($ip, $port) = @_; |
1047
|
0
|
0
|
0
|
|
|
0
|
if (ref $ip && !defined $port) { |
1048
|
0
|
|
|
|
|
0
|
print ip2addr($ip->{IP}), ':', $ip->{Port}; |
1049
|
|
|
|
|
|
|
} else { |
1050
|
0
|
|
|
|
|
0
|
print ip2addr($ip), ':', $port; |
1051
|
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
} |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
sub idAddr { |
1055
|
69
|
|
|
69
|
0
|
98
|
my ($ip, $port) = @_; |
1056
|
69
|
50
|
33
|
|
|
300
|
if (ref $ip && !defined $port) { |
1057
|
69
|
|
|
|
|
538
|
return $ip->{IP}.':'.$ip->{Port}; |
1058
|
|
|
|
|
|
|
} else { |
1059
|
0
|
|
|
|
|
|
return "$ip:$port"; |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
} |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
1; |
1064
|
|
|
|
|
|
|
__END__ |