File Coverage

blib/lib/P2P/pDonkey/Packet.pm
Criterion Covered Total %
statement 369 421 87.6
branch 0 30 0.0
condition 0 8 0.0
subroutine 123 134 91.7
pod 7 11 63.6
total 499 604 82.6


line stmt bran cond sub pod time code
1             # P2P::pDonkey::Packet.pm
2             #
3             # Copyright (c) 2003 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::Packet;
9              
10 1     1   7110 use 5.006;
  1         3  
  1         37  
11 1     1   5 use strict;
  1         2  
  1         28  
12 1     1   5 use warnings;
  1         1  
  1         244  
13              
14             require Exporter;
15              
16             our $VERSION = '0.05';
17              
18             our @ISA = qw(Exporter);
19              
20             our %EXPORT_TAGS = ( 'all' => [ qw(
21             PT_TEST
22             PacketTagName
23             packBody unpackBody
24             packUDPHeader unpackUDPHeader
25             packTCPHeader unpackTCPHeader
26              
27             SZ_UDP_HEADER
28             SZ_TCP_HEADER
29              
30             PT_HEADER
31             PT_HELLO
32             PT_HELLOSERVER
33             PT_HELLOCLIENT
34             PT_BADPROTOCOL
35             PT_GETSERVERLIST
36             PT_OFFERFILES
37             PT_SEARCHFILE
38             PT_DISCONNECT
39             PT_GETSOURCES
40             PT_SEARCHUSER
41             PT_CLIENTCBREQ
42             PT_MORERESULTS
43             PT_SERVERLIST
44             PT_SEARCHFILERES
45             PT_SERVERSTATUS
46             PT_SERVERCBREQ
47             PT_CBFAIL
48             PT_SERVERMESSAGE
49             PT_IDCHANGE
50             PT_SERVERINFODATA
51             PT_FOUNDSOURCES
52             PT_SEARCHUSERRES
53             PT_SENDINGPART
54             PT_REQUESTPARTS
55             PT_NOSUCHFILE
56             PT_ENDOFOWNLOAD
57             PT_VIEWFILES
58             PT_VIEWFILESANS
59             PT_HELLOANSWER
60             PT_NEWCLIENTID
61             PT_MESSAGE
62             PT_FILESTATUSREQ
63             PT_FILESTATUS
64             PT_HASHSETREQUEST
65             PT_HASHSETANSWER
66             PT_SLOTREQUEST
67             PT_SLOTGIVEN
68             PT_SLOTRELEASE
69             PT_SLOTTAKEN
70             PT_FILEREQUEST
71             PT_FILEREQANSWER
72             PT_UDP_SERVERSTATUSREQ
73             PT_UDP_SERVERSTATUS
74             PT_UDP_SEARCHFILE
75             PT_UDP_SEARCHFILERES
76             PT_UDP_GETSOURCES
77             PT_UDP_FOUNDSOURCES
78             PT_UDP_CBREQUEST
79             PT_UDP_CBFAIL
80             PT_UDP_NEWSERVER
81             PT_UDP_SERVERLIST
82             PT_UDP_SERVERINFO
83             PT_UDP_GETSERVERINFO
84             PT_UDP_GETSERVERLIST
85              
86             PT_ADM_LOGIN
87             PT_ADM_STOP
88             PT_ADM_COMMAND
89             PT_ADM_SERVER_LIST
90             PT_ADM_FRIEND_LIST
91             PT_ADM_SHARED_DIRS
92             PT_ADM_SHARED_FILES
93             PT_ADM_GAP_DETAILS
94             PT_ADM_CORE_STATUS
95             PT_ADM_MESSAGE
96             PT_ADM_ERROR_MESSAGE
97             PT_ADM_CONNECTED
98             PT_ADM_DISCONNECTED
99             PT_ADM_SERVER_STATUS
100             PT_ADM_EXTENDING_SEARCH
101             PT_ADM_FILE_INFO
102             PT_ADM_SEARCH_FILE_RES
103             PT_ADM_NEW_DOWNLOAD
104             PT_ADM_REMOVE_DOWNLOAD
105             PT_ADM_NEW_UPLOAD
106             PT_ADM_REMOVE_UPLOAD
107             PT_ADM_NEW_UPLOAD_SLOT
108             PT_ADM_REMOVE_UPLOAD_SLOT
109             PT_ADM_FRIEND_FILES
110             PT_ADM_HASHING
111             PT_ADM_FRIEND_LIST_UPDATE
112             PT_ADM_DOWNLOAD_STATUS
113             PT_ADM_UPLOAD_STATUS
114             PT_ADM_OPTIONS
115             PT_ADM_CONNECT
116             PT_ADM_DISCONNECT
117             PT_ADM_SEARCH_FILE
118             PT_ADM_EXTEND_SEARCH_FILE
119             PT_ADM_MORE_RESULTS
120             PT_ADM_SEARCH_USER
121             PT_ADM_EXTEND_SEARCH_USER
122             PT_ADM_DOWNLOAD
123             PT_ADM_PAUSE_DOWNLOAD
124             PT_ADM_RESUME_DOWNLOAD
125             PT_ADM_CANCEL_DOWNLOAD
126             PT_ADM_SET_FILE_PRI
127             PT_ADM_VIEW_FRIEND_FILES
128             PT_ADM_GET_SERVER_LIST
129             PT_ADM_GET_CLIENT_LIST
130             PT_ADM_GET_SHARED_DIRS
131             PT_ADM_SET_SHARED_DIRS
132             PT_ADM_START_DL_STATUS
133             PT_ADM_STOP_DL_STATUS
134             PT_ADM_START_UL_STATUS
135             PT_ADM_STOP_UL_STATUS
136             PT_ADM_DELETE_SERVER
137             PT_ADM_ADD_SERVER
138             PT_ADM_SET_SERVER_PRI
139             PT_ADM_GET_SHARED_FILES
140             PT_ADM_GET_OPTIONS
141             PT_ADM_DOWNLOAD_FILE
142             PT_ADM_GET_GAP_DETAILS
143             PT_ADM_GET_CORE_STATUS
144             ) ] );
145              
146             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
147              
148             our @EXPORT = qw(
149            
150             );
151              
152              
153             # Preloaded methods go here.
154              
155 1     1   6 use Carp;
  1         2  
  1         61  
156 1     1   954 use POSIX 'ceil';
  1         7377  
  1         7  
157 1     1   1979 use P2P::pDonkey::Meta ':all';
  1         3  
  1         631  
158              
159 1     1   4 use constant PT_TEST => 0x3f;
  1         2  
  1         44  
160              
161             # --- packet headers
162 1     1   4 use constant SZ_UDP_HEADER => 1; # 1 (header marker)
  1         2  
  1         36  
163 1     1   4 use constant SZ_TCP_HEADER => 5; # 1 (header marker) + 4 (packet length)
  1         1  
  1         30  
164             # --- packet types
165 1     1   9 use constant PT_HEADER => 0xe3;
  1         2  
  1         36  
166 1     1   4 use constant PT_HELLO => 0x01; # 2 hello packets!!!
  1         1  
  1         31  
167 1     1   3 use constant PT_HELLOSERVER => 1.1; # uses PT_HELLO
  1         2  
  1         33  
168 1     1   4 use constant PT_HELLOCLIENT => 1.2; # uses PT_HELLO
  1         1  
  1         30  
169 1     1   4 use constant PT_HELLOCLIENT_TAG => 0x10;
  1         5  
  1         41  
170             # unused by server 0x02 - 0x04
171 1     1   4 use constant PT_BADPROTOCOL => 0x05;
  1         2  
  1         33  
172             # client <-> server
173 1     1   4 use constant PT_GETSERVERLIST => 0x14;
  1         1  
  1         39  
174 1     1   3 use constant PT_OFFERFILES => 0x15;
  1         2  
  1         27  
175 1     1   4 use constant PT_SEARCHFILE => 0x16;
  1         1  
  1         33  
176             # unused by server 0x17
177 1     1   3 use constant PT_DISCONNECT => 0x18;
  1         3  
  1         27  
178 1     1   4 use constant PT_GETSOURCES => 0x19;
  1         1  
  1         37  
179 1     1   3 use constant PT_SEARCHUSER => 0x1a;
  1         1  
  1         34  
180             # ? 0x1b
181 1     1   4 use constant PT_CLIENTCBREQ => 0x1c;
  1         1  
  1         29  
182             # Exception in Connection::doTask 25 0x20 for 16.39
183 1     1   3 use constant PT_MORERESULTS => 0x21;
  1         1  
  1         32  
184             # unused by server 0x22 - 0x31
185 1     1   4 use constant PT_SERVERLIST => 0x32;
  1         1  
  1         28  
186 1     1   4 use constant PT_SEARCHFILERES => 0x33;
  1         1  
  1         32  
187 1     1   4 use constant PT_SERVERSTATUS => 0x34;
  1         1  
  1         26  
188 1     1   9 use constant PT_SERVERCBREQ => 0x35;
  1         1  
  1         27  
189 1     1   77 use constant PT_CBFAIL => 0x36;
  1         1  
  1         54  
190             # unused by server 0x37
191 1     1   4 use constant PT_SERVERMESSAGE => 0x38;
  1         1  
  1         29  
192             # unused by server 0x39 - 0x3f
193 1     1   4 use constant PT_IDCHANGE => 0x40;
  1         1  
  1         32  
194 1     1   4 use constant PT_SERVERINFODATA => 0x41;
  1         1  
  1         31  
195 1     1   4 use constant PT_FOUNDSOURCES => 0x42;
  1         10  
  1         37  
196 1     1   4 use constant PT_SEARCHUSERRES => 0x43;
  1         2  
  1         45  
197             # unused by server 0x44 - 0x45
198             # client <-> client
199 1     1   4 use constant PT_SENDINGPART => 0x46;
  1         1  
  1         63  
200 1     1   5 use constant PT_REQUESTPARTS => 0x47;
  1         1  
  1         52  
201 1     1   5 use constant PT_NOSUCHFILE => 0x48;
  1         9  
  1         45  
202 1     1   11 use constant PT_ENDOFOWNLOAD => 0x49;
  1         2  
  1         42  
203 1     1   5 use constant PT_VIEWFILES => 0x4a;
  1         2  
  1         47  
204 1     1   5 use constant PT_VIEWFILESANS => 0x4b;
  1         2  
  1         41  
205 1     1   5 use constant PT_HELLOANSWER => 0x4c;
  1         2  
  1         46  
206 1     1   5 use constant PT_NEWCLIENTID => 0x4d;
  1         2  
  1         47  
207 1     1   4 use constant PT_MESSAGE => 0x4e;
  1         8  
  1         39  
208 1     1   5 use constant PT_FILESTATUSREQ => 0x4f;
  1         2  
  1         53  
209 1     1   5 use constant PT_FILESTATUS => 0x50;
  1         2  
  1         41  
210 1     1   5 use constant PT_HASHSETREQUEST => 0x51;
  1         2  
  1         47  
211 1     1   6 use constant PT_HASHSETANSWER => 0x52;
  1         2  
  1         47  
212             # ? 0x53
213 1     1   6 use constant PT_SLOTREQUEST => 0x54;
  1         1  
  1         48  
214 1     1   5 use constant PT_SLOTGIVEN => 0x55;
  1         2  
  1         54  
215 1     1   5 use constant PT_SLOTRELEASE => 0x56;
  1         1  
  1         41  
216 1     1   6 use constant PT_SLOTTAKEN => 0x57;
  1         2  
  1         46  
217 1     1   12 use constant PT_FILEREQUEST => 0x58;
  1         2  
  1         61  
218 1     1   6 use constant PT_FILEREQANSWER => 0x59;
  1         1  
  1         43  
219             # client <-> UDP server
220 1     1   5 use constant PT_UDP_SERVERSTATUSREQ => 0x96;
  1         2  
  1         46  
221 1     1   5 use constant PT_UDP_SERVERSTATUS => 0x97;
  1         2  
  1         47  
222 1     1   5 use constant PT_UDP_SEARCHFILE => 0x98;
  1         2  
  1         40  
223 1     1   5 use constant PT_UDP_SEARCHFILERES => 0x99;
  1         2  
  1         49  
224 1     1   6 use constant PT_UDP_GETSOURCES => 0x9a;
  1         2  
  1         40  
225 1     1   5 use constant PT_UDP_FOUNDSOURCES => 0x9b;
  1         2  
  1         46  
226 1     1   6 use constant PT_UDP_CBREQUEST => 0x9c;
  1         14  
  1         49  
227             # unused by server 0x9d
228 1     1   5 use constant PT_UDP_CBFAIL => 0x9e;
  1         2  
  1         42  
229             # unused by server 0x9f
230 1     1   5 use constant PT_UDP_NEWSERVER => 0xa0;
  1         2  
  1         45  
231 1     1   6 use constant PT_UDP_SERVERLIST => 0xa1;
  1         1  
  1         76  
232 1     1   6 use constant PT_UDP_GETSERVERINFO => 0xa2;
  1         2  
  1         46  
233 1     1   6 use constant PT_UDP_SERVERINFO => 0xa3;
  1         2  
  1         45  
234 1     1   5 use constant PT_UDP_GETSERVERLIST => 0xa4;
  1         2  
  1         49  
235             # CORE <-> GUI
236 1     1   5 use constant PT_ADM_LOGIN => 0x64;
  1         2  
  1         60  
237 1     1   5 use constant PT_ADM_STOP => 0x65;
  1         2  
  1         240  
238 1     1   6 use constant PT_ADM_COMMAND => 0x66;
  1         1  
  1         46  
239 1     1   5 use constant PT_ADM_SERVER_LIST => 0xaa;
  1         2  
  1         47  
240 1     1   5 use constant PT_ADM_FRIEND_LIST => 0xab;
  1         1  
  1         42  
241 1     1   6 use constant PT_ADM_SHARED_DIRS => 0xac;
  1         2  
  1         47  
242 1     1   5 use constant PT_ADM_SHARED_FILES => 0xad;
  1         1  
  1         48  
243 1     1   6 use constant PT_ADM_GAP_DETAILS => 0xae;
  1         2  
  1         40  
244 1     1   5 use constant PT_ADM_CORE_STATUS => 0xaf;
  1         2  
  1         54  
245 1     1   5 use constant PT_ADM_MESSAGE => 0xb4;
  1         81  
  1         45  
246 1     1   5 use constant PT_ADM_ERROR_MESSAGE => 0xb5;
  1         1  
  1         40  
247 1     1   5 use constant PT_ADM_CONNECTED => 0xb6;
  1         2  
  1         40  
248 1     1   5 use constant PT_ADM_DISCONNECTED => 0xb7;
  1         2  
  1         45  
249 1     1   4 use constant PT_ADM_SERVER_STATUS => 0xb8;
  1         1  
  1         40  
250 1     1   4 use constant PT_ADM_EXTENDING_SEARCH => 0xb9;
  1         2  
  1         41  
251 1     1   4 use constant PT_ADM_FILE_INFO => 0xba;
  1         1  
  1         41  
252 1     1   5 use constant PT_ADM_SEARCH_FILE_RES => 0xbb;
  1         1  
  1         54  
253 1     1   5 use constant PT_ADM_NEW_DOWNLOAD => 0xbc;
  1         2  
  1         36  
254 1     1   5 use constant PT_ADM_REMOVE_DOWNLOAD => 0xbd;
  1         1  
  1         42  
255 1     1   4 use constant PT_ADM_NEW_UPLOAD => 0xbe;
  1         2  
  1         46  
256 1     1   6 use constant PT_ADM_REMOVE_UPLOAD => 0xbf;
  1         1  
  1         42  
257 1     1   4 use constant PT_ADM_NEW_UPLOAD_SLOT => 0xc0;
  1         2  
  1         47  
258 1     1   5 use constant PT_ADM_REMOVE_UPLOAD_SLOT => 0xc1;
  1         1  
  1         37  
259 1     1   5 use constant PT_ADM_FRIEND_FILES => 0xc2;
  1         1  
  1         54  
260 1     1   4 use constant PT_ADM_HASHING => 0xc3;
  1         2  
  1         35  
261 1     1   4 use constant PT_ADM_FRIEND_LIST_UPDATE => 0xc4;
  1         1  
  1         41  
262 1     1   5 use constant PT_ADM_DOWNLOAD_STATUS => 0xc5;
  1         2  
  1         40  
263 1     1   4 use constant PT_ADM_UPLOAD_STATUS => 0xc6;
  1         2  
  1         36  
264 1     1   4 use constant PT_ADM_OPTIONS => 0xc7;
  1         1  
  1         41  
265 1     1   5 use constant PT_ADM_CONNECT => 0xc8;
  1         1  
  1         36  
266 1     1   4 use constant PT_ADM_DISCONNECT => 0xc9;
  1         2  
  1         70  
267 1     1   4 use constant PT_ADM_SEARCH_FILE => 0xca;
  1         2  
  1         98  
268 1     1   6 use constant PT_ADM_EXTEND_SEARCH_FILE => 0xcb;
  1         1  
  1         39  
269 1     1   5 use constant PT_ADM_MORE_RESULTS => 0xcc;
  1         1  
  1         43  
270 1     1   4 use constant PT_ADM_SEARCH_USER => 0xcd;
  1         2  
  1         37  
271 1     1   4 use constant PT_ADM_EXTEND_SEARCH_USER => 0xce;
  1         2  
  1         42  
272 1     1   5 use constant PT_ADM_DOWNLOAD => 0xcf;
  1         2  
  1         40  
273 1     1   5 use constant PT_ADM_PAUSE_DOWNLOAD => 0xd0;
  1         6  
  1         36  
274 1     1   5 use constant PT_ADM_RESUME_DOWNLOAD => 0xd1;
  1         2  
  1         50  
275 1     1   4 use constant PT_ADM_CANCEL_DOWNLOAD => 0xd2;
  1         2  
  1         41  
276 1     1   4 use constant PT_ADM_SET_FILE_PRI => 0xd3;
  1         2  
  1         42  
277 1     1   4 use constant PT_ADM_VIEW_FRIEND_FILES => 0xd4;
  1         2  
  1         36  
278 1     1   4 use constant PT_ADM_GET_SERVER_LIST => 0xd5;
  1         8  
  1         36  
279 1     1   4 use constant PT_ADM_GET_CLIENT_LIST => 0xd6;
  1         1  
  1         40  
280 1     1   4 use constant PT_ADM_GET_SHARED_DIRS => 0xd7;
  1         1  
  1         36  
281 1     1   5 use constant PT_ADM_SET_SHARED_DIRS => 0xd8;
  1         1  
  1         48  
282 1     1   4 use constant PT_ADM_START_DL_STATUS => 0xd9;
  1         2  
  1         42  
283 1     1   4 use constant PT_ADM_STOP_DL_STATUS => 0xda;
  1         2  
  1         36  
284 1     1   5 use constant PT_ADM_START_UL_STATUS => 0xdb;
  1         2  
  1         40  
285 1     1   5 use constant PT_ADM_STOP_UL_STATUS => 0xdc;
  1         1  
  1         36  
286 1     1   4 use constant PT_ADM_DELETE_SERVER => 0xdd;
  1         2  
  1         47  
287 1     1   5 use constant PT_ADM_ADD_SERVER => 0xde;
  1         1  
  1         40  
288 1     1   5 use constant PT_ADM_SET_SERVER_PRI => 0xdf;
  1         1  
  1         35  
289 1     1   4 use constant PT_ADM_GET_SHARED_FILES => 0xe0;
  1         1  
  1         49  
290 1     1   4 use constant PT_ADM_GET_OPTIONS => 0xe1;
  1         2  
  1         42  
291 1     1   5 use constant PT_ADM_DOWNLOAD_FILE => 0xe2;
  1         2  
  1         40  
292 1     1   5 use constant PT_ADM_GET_GAP_DETAILS => 0xe3;
  1         1  
  1         42  
293 1     1   4 use constant PT_ADM_GET_CORE_STATUS => 0xe4;
  1         12  
  1         10824  
294              
295             my (@PacketTagName, @packTable, @unpackTable);
296              
297             sub PacketTagName {
298 0     0 1   my $name = $PacketTagName[$_[0]];
299 0 0         return $name ? $name : sprintf("Unknown(0x%x)", $_[0]);
300             }
301              
302             # empty body
303             my $packEmpty = sub {
304             return '';
305             };
306             my $unpackEmpty = sub {
307             return 1;
308             };
309              
310             sub unpackBody {
311 0     0 1   my ($pt) = shift;
312 0 0         defined($$pt = &unpackB) or return;
313 0           my $f;
314 0 0         if ($$pt == PT_HELLO) {
315 0           my $off = $_[1];
316 0           my $d;
317 0           $f = $unpackTable[PT_HELLOCLIENT];
318 0 0         if (defined($d = &$f)) {
319 0           $$pt = PT_HELLOCLIENT;
320 0           return $d;
321             } else {
322 0           $_[1] = $off;
323 0           $$pt = PT_HELLOSERVER;
324 0           $f = $unpackTable[PT_HELLOSERVER];
325 0           return &$f;
326             }
327             } else {
328 0           $f = $unpackTable[$$pt];
329 0 0 0       defined($f)
330             or carp("Don't know how to unpack " . sprintf("0x%x",$$pt) . " packets\n")
331             && return;
332 0           return &$f;
333             }
334             }
335             sub packBody {
336 0     0 1   my $pt = shift;
337 0           my $f;
338 0 0         defined($f = $packTable[$pt]) or return;
339             # $f or confess "Don't know how to pack ".sprintf("0x%x",$pt)." packets\n";
340             # return pack('Ca*', $pt, &$f);
341 0 0         return $f ? pack('Ca*', $pt, &$f) : pack('C', $pt);
342             }
343              
344             sub unpackUDPHeader {
345 0     0 1   my $pth;
346 0 0 0       defined ($pth = &unpackB) and $pth == PT_HEADER or return;
347 0           return 1;
348             }
349             sub packUDPHeader {
350 0     0 1   return pack('C', PT_HEADER);
351             }
352              
353             sub unpackTCPHeader {
354 0     0 1   my ($len, $pth);
355 0 0 0       defined($pth = &unpackB) and $pth == PT_HEADER or return;
356 0 0         defined($len = &unpackD) or return;
357 0           return $len;
358             }
359             sub packTCPHeader {
360 0     0 1   return pack('CL', PT_HEADER, @_);
361             }
362              
363             # -------------------------------------------------------------------
364             $PacketTagName[PT_TEST] = 'test';
365             $unpackTable[PT_TEST] = $unpackEmpty;
366             $packTable[PT_TEST] = $packEmpty;
367             # -------------------------------------------------------------------
368             # -------------------------------------------------------------------
369             $PacketTagName[PT_HEADER] = 'Header';
370             # -------------------------------------------------------------------
371             $PacketTagName[PT_HELLO] = 'Hello';
372             $unpackTable[PT_HELLO] = sub {
373             croak('You must specify PT_HELLOSERVER or PT_HELLOCLIENT instead of PT_HELLO.');
374             };
375             $packTable[PT_HELLO] = sub {
376             croak('You must specify PT_HELLOSERVER or PT_HELLOCLIENT instead of PT_HELLO.');
377             };
378             # -------------------------------------------------------------------
379             $PacketTagName[PT_HELLOCLIENT] = 'Hello client';
380             $unpackTable[PT_HELLOCLIENT] = sub {
381             my ($d, $subtag);
382             defined($subtag = &unpackB)
383             and $subtag == PT_HELLOCLIENT_TAG
384             and defined($d = &unpackInfo)
385             and ($d->{ServerIP}, $d->{ServerPort}) = &unpackAddr
386             or return;
387             return $d;
388             };
389             $packTable[PT_HELLOCLIENT] = sub {
390             my ($d) = @_;
391             return packB(PT_HELLOCLIENT_TAG) . &packInfo
392             . packAddr($d->{ServerIP}, $d->{ServerPort});
393             };
394             # -------------------------------------------------------------------
395             $PacketTagName[PT_HELLOSERVER] = 'Hello server';
396             $unpackTable[PT_HELLOSERVER] = \&unpackInfo;
397             $packTable[PT_HELLOSERVER] = \&packInfo;
398             # -------------------------------------------------------------------
399             $PacketTagName[PT_BADPROTOCOL] = 'Bad protocol';
400             $unpackTable[PT_BADPROTOCOL] = $unpackEmpty;
401             $packTable[PT_BADPROTOCOL] = $packEmpty;
402             # -------------------------------------------------------------------
403             $PacketTagName[PT_GETSERVERLIST] = 'Get server list';
404             $unpackTable[PT_GETSERVERLIST] = $unpackEmpty;
405             $packTable[PT_GETSERVERLIST] = $packEmpty;
406             # -------------------------------------------------------------------
407             $PacketTagName[PT_OFFERFILES] = 'Offer files';
408             $unpackTable[PT_OFFERFILES] = \&unpackInfoList;
409             $packTable[PT_OFFERFILES] = \&packInfoList;
410             # -------------------------------------------------------------------
411             $PacketTagName[PT_SEARCHFILE] = 'Search file';
412             $unpackTable[PT_SEARCHFILE] = \&unpackSearchQuery;
413             $packTable[PT_SEARCHFILE] = \&packSearchQuery;
414             # -------------------------------------------------------------------
415             $PacketTagName[PT_DISCONNECT] = 'Disconnect';
416             $unpackTable[PT_DISCONNECT] = $unpackEmpty;
417             $packTable[PT_DISCONNECT] = $packEmpty;
418             # -------------------------------------------------------------------
419             $PacketTagName[PT_GETSOURCES] = 'Get sources';
420             $unpackTable[PT_GETSOURCES] = \&unpackHash;
421             $packTable[PT_GETSOURCES] = \&packHash;
422             # -------------------------------------------------------------------
423             $PacketTagName[PT_SEARCHUSER] = 'Search user';
424             $unpackTable[PT_SEARCHUSER] = \&unpackSearchQuery;
425             $packTable[PT_SEARCHUSER] = \&packSearchQuery;
426             # -------------------------------------------------------------------
427             $PacketTagName[PT_CLIENTCBREQ] = 'Client callback request';
428             $unpackTable[PT_CLIENTCBREQ] = \&unpackD;
429             $packTable[PT_CLIENTCBREQ] = \&packD;
430             # -------------------------------------------------------------------
431             $PacketTagName[PT_MORERESULTS] = 'More results';
432             $unpackTable[PT_MORERESULTS] = $unpackEmpty;
433             $packTable[PT_MORERESULTS] = $packEmpty;
434             # -------------------------------------------------------------------
435             $PacketTagName[PT_SERVERLIST] = 'Server list';
436             $unpackTable[PT_SERVERLIST] = \&unpackAddrList;
437             $packTable[PT_SERVERLIST] = \&packAddrList;
438             # -------------------------------------------------------------------
439             $PacketTagName[PT_SEARCHFILERES] = 'Search file results';
440             $unpackTable[PT_SEARCHFILERES] = sub {
441             my ($res, $more);
442             $res = &unpackInfoList or return;
443             defined($more = &unpackB) or return;
444             return ($res, $more);
445             };
446             $packTable[PT_SEARCHFILERES] = sub {
447             my ($res, $more) = @_;
448             return packInfoList($res) . packB($more);
449             };
450             # -------------------------------------------------------------------
451             $PacketTagName[PT_SERVERSTATUS] = 'Server status';
452             $unpackTable[PT_SERVERSTATUS] = sub {
453             my ($users, $files);
454             defined($users = &unpackD) or return;
455             defined($files = &unpackD) or return;
456             # return {Users => $users, Files => $files};
457             return ($users, $files);
458             };
459             $packTable[PT_SERVERSTATUS] = sub {
460             # my ($d) = @_;
461             # return pack('LL', $d->{Users}, $d->{Files});
462             return pack('LL', @_);
463             };
464             # -------------------------------------------------------------------
465             $PacketTagName[PT_SERVERCBREQ] = 'Server callback request';
466             $unpackTable[PT_SERVERCBREQ] = \&unpackAddr;
467             $packTable[PT_SERVERCBREQ] = \&packAddr;
468             # -------------------------------------------------------------------
469             $PacketTagName[PT_CBFAIL] = 'Callback fail';
470             $unpackTable[PT_CBFAIL] = \&unpackD;
471             $packTable[PT_CBFAIL] = \&packD;
472             # -------------------------------------------------------------------
473             $PacketTagName[PT_SERVERMESSAGE] = 'Server message';
474             $unpackTable[PT_SERVERMESSAGE] = \&unpackS;
475             $packTable[PT_SERVERMESSAGE] = \&packS;
476             # -------------------------------------------------------------------
477             $PacketTagName[PT_IDCHANGE] = 'ID change';
478             $unpackTable[PT_IDCHANGE] = \&unpackD;
479             $packTable[PT_IDCHANGE] = \&packD;
480             # -------------------------------------------------------------------
481             $PacketTagName[PT_SERVERINFODATA] = 'Server info data';
482             $unpackTable[PT_SERVERINFODATA] = \&unpackInfo;
483             $packTable[PT_SERVERINFODATA] = \&packInfo;
484             # -------------------------------------------------------------------
485             $PacketTagName[PT_FOUNDSOURCES] = 'Found sources';
486             my $unpackFoundSources = sub {
487             my ($hash, $addrl);
488             defined($hash = &unpackHash) or return;
489             $addrl = &unpackAddrList or return;
490             # return {Hash => $hash, Addresses => $addrl};
491             return ($hash, $addrl);
492             };
493             my $packFoundSources = sub {
494             # my ($d) = @_;
495             # return packHash($d->{Hash}) . packAddrList($d->{Addresses});
496             my ($hash, $addrl) = @_;
497             return packHash($hash) . packAddrList($addrl);
498             };
499             $unpackTable[PT_FOUNDSOURCES] = $unpackFoundSources;
500             $packTable[PT_FOUNDSOURCES] = $packFoundSources;
501             # -------------------------------------------------------------------
502             $PacketTagName[PT_SEARCHUSERRES] = 'Search user results';
503             $unpackTable[PT_SEARCHUSERRES] = \&unpackInfoList;
504             $packTable[PT_SEARCHUSERRES] = \&packInfoList;
505             # -------------------------------------------------------------------
506             $PacketTagName[PT_SENDINGPART] = 'Sending part';
507             $unpackTable[PT_SENDINGPART] = sub {
508             my ($hash, $start, $end, $data);
509             defined($hash = &unpackHash) or return;
510             defined($start = &unpackD) or return;
511             defined($end = &unpackD) or return;
512             my $len = $end - $start;
513             $len > 0 or return;
514             $data = unpack("x$_[1] a$len", $_[0]); # copy data for postprocessing
515             # return {Hash => $hash, Start => $start, End => $end, Data => \$data};
516             $_[1] += $len;
517             return ($hash, $start, $end, \$data);
518             };
519             $packTable[PT_SENDINGPART] = sub {
520             # my ($d) = @_;
521             # return packHash($d->{Hash})
522             # . pack('LL a*', $d->{Start}, $d->{End}, $$d->{Data});
523             my ($hash, $start, $end, $data) = @_;
524             return packHash($hash) . pack('LL a*', $start, $end, $$data)
525             };
526             # -------------------------------------------------------------------
527             $PacketTagName[PT_REQUESTPARTS] = 'Request parts';
528             $unpackTable[PT_REQUESTPARTS] = sub {
529             my ($hash, $o, @start, @end);
530             defined($hash = &unpackHash) or return;
531             defined($o = &unpackD) and push(@start, $o) or return;
532             defined($o = &unpackD) and push(@start, $o) or return;
533             defined($o = &unpackD) and push(@start, $o) or return;
534             defined($o = &unpackD) and push(@end, $o) or return;
535             defined($o = &unpackD) and push(@end, $o) or return;
536             defined($o = &unpackD) and push(@end, $o) or return;
537             # return {Hash => $hash, Gaps => [sort {$a <=> $b} (@start, @end)]};
538             return ($hash, sort {$a <=> $b} (@start, @end));
539             };
540             $packTable[PT_REQUESTPARTS] = sub {
541             my $hash = shift;
542             # my ($d) = @_;
543             my ($gaps, @start, @end);
544             # $gaps = $d->{Gaps};
545             foreach my $i (0, 2, 4) {
546             # push @start, $gaps->[$i];
547             # push @end, $gaps->[$i+1];
548             push @start, ($_[$i] or 0);
549             push @end, ($_[$i+1] or 0);
550             }
551             return packHash($hash) . pack('LLLLLL', @start, @end);
552             # return packHash($d->{Hash}) . pack('LLLLLL', @start, @end);
553             };
554             # -------------------------------------------------------------------
555             $PacketTagName[PT_NOSUCHFILE] = 'No such file';
556             $unpackTable[PT_NOSUCHFILE] = \&unpackHash;
557             $packTable[PT_NOSUCHFILE] = \&packHash;
558             # -------------------------------------------------------------------
559             $PacketTagName[PT_ENDOFOWNLOAD] = 'End of download';
560             $unpackTable[PT_ENDOFOWNLOAD] = \&unpackHash;
561             $packTable[PT_ENDOFOWNLOAD] = \&packHash;
562             # -------------------------------------------------------------------
563             $PacketTagName[PT_VIEWFILES] = 'View files';
564             $unpackTable[PT_VIEWFILES] = $unpackEmpty;
565             $packTable[PT_VIEWFILES] = $packEmpty;
566             # -------------------------------------------------------------------
567             $PacketTagName[PT_VIEWFILESANS] = 'View files answer';
568             $unpackTable[PT_VIEWFILESANS] = \&unpackInfoList;
569             $packTable[PT_VIEWFILESANS] = \&packInfoList;
570             # -------------------------------------------------------------------
571             $PacketTagName[PT_HELLOANSWER] = 'Hello answer';
572             $unpackTable[PT_HELLOANSWER] = sub {
573             my ($uinfo, $sip, $sport);
574             $uinfo = &unpackInfo or return;
575             ($uinfo->{ServerIP}, $uinfo->{ServerPort}) = &unpackAddr or return;
576             return $uinfo;
577             };
578             $packTable[PT_HELLOANSWER] = sub {
579             my ($d) = @_;
580             return packInfo($d) . packAddr($d->{ServerIP}, $d->{ServerPort});
581             };
582             # -------------------------------------------------------------------
583             $PacketTagName[PT_NEWCLIENTID] = 'New client ID';
584             $unpackTable[PT_NEWCLIENTID] = sub {
585             my ($id, $newid);
586             defined($id = &unpackD) or return;
587             defined($newid = &unpackD) or return;
588             # return {Users => $users, Files => $files};
589             return ($id, $newid);
590             };
591             $packTable[PT_NEWCLIENTID] = sub {
592             # my ($d) = @_;
593             # return pack('LL', $d->{Users}, $d->{Files});
594             return pack('LL', @_);
595             };
596             # -------------------------------------------------------------------
597             $PacketTagName[PT_MESSAGE] = 'Message';
598             $unpackTable[PT_MESSAGE] = \&unpackS;
599             $packTable[PT_MESSAGE] = \&packS;
600             # -------------------------------------------------------------------
601             $PacketTagName[PT_FILESTATUSREQ] = 'File status request';
602             $unpackTable[PT_FILESTATUSREQ] = \&unpackHash;
603             $packTable[PT_FILESTATUSREQ] = \&packHash;
604             # -------------------------------------------------------------------
605             $PacketTagName[PT_FILESTATUS] = 'File status';
606             $unpackTable[PT_FILESTATUS] = sub {
607             my ($hash, $nparts, @status);
608             defined($hash = &unpackHash) or return;
609             defined($nparts = &unpackW) or return;
610             if ($nparts) {
611             my $len;
612             $_ = unpack("x$_[1] b$nparts", $_[0]);
613             defined && (($len = length) == $nparts) or return;
614             $_[1] += ceil $nparts/8;
615             while ($len--) { unshift @status, chop }
616             } else {
617             # handle 00 00 00
618             &unpackB;
619             }
620             # return {Hash => $hash, Status => $status};
621             return ($hash, \@status);
622             };
623             $packTable[PT_FILESTATUS] = sub {
624             # my ($d) = @_;
625             # return packHash($d->{Hash})
626             # . pack('S b*', length $d->{Status}, $d->{Status});
627             my ($hash, $status) = @_;
628             my $st = join '', @$status;
629             return packHash($hash) . pack('S b*', length $st, $st);
630             };
631             # -------------------------------------------------------------------
632             $PacketTagName[PT_HASHSETREQUEST] = 'Hashset request';
633             $unpackTable[PT_HASHSETREQUEST] = \&unpackHash;
634             $packTable[PT_HASHSETREQUEST] = \&packHash;
635             # -------------------------------------------------------------------
636             $PacketTagName[PT_HASHSETANSWER] = 'Hashset answer';
637             $unpackTable[PT_HASHSETANSWER] = sub {
638             my ($hash, $nparts, @parthashes, $ph);
639             defined($hash = &unpackHash) or return;
640             defined($nparts = &unpackW) or return;
641             @parthashes = ();
642             while ($nparts--) {
643             defined($ph = &unpackHash) or return;
644             push @parthashes, $ph;
645             }
646             # return {Hash => $hash, Parthashes => \@parthashes};
647             return ($hash, \@parthashes);
648             };
649             $packTable[PT_HASHSETANSWER] = sub {
650             my ($hash, $parthashes) = @_;
651             # my ($d) = @_;
652             # my $parthashes = $d->{Parthashes};
653             # my $res = packHash($d->{Hash}) . packW(scalar @$parthashes);
654             my $res = packHash($hash) . packW(scalar @$parthashes);
655             foreach my $ph (@$parthashes) {
656             $res .= packHash($ph);
657             }
658             return $res;
659             };
660             # -------------------------------------------------------------------
661             $PacketTagName[PT_SLOTREQUEST] = 'Slot request';
662             $unpackTable[PT_SLOTREQUEST] = $unpackEmpty;
663             $packTable[PT_SLOTREQUEST] = $packEmpty;
664             # -------------------------------------------------------------------
665             $PacketTagName[PT_SLOTGIVEN] = 'Slot given';
666             $unpackTable[PT_SLOTGIVEN] = $unpackEmpty;
667             $packTable[PT_SLOTGIVEN] = $packEmpty;
668             # -------------------------------------------------------------------
669             $PacketTagName[PT_SLOTRELEASE] = 'Slot release';
670             $unpackTable[PT_SLOTRELEASE] = $unpackEmpty;
671             $packTable[PT_SLOTRELEASE] = $packEmpty;
672             # -------------------------------------------------------------------
673             $PacketTagName[PT_SLOTTAKEN] = 'Slot taken';
674             $unpackTable[PT_SLOTTAKEN] = $unpackEmpty;
675             $packTable[PT_SLOTTAKEN] = $packEmpty;
676             # -------------------------------------------------------------------
677             $PacketTagName[PT_FILEREQUEST] = 'File request';
678             $unpackTable[PT_FILEREQUEST] = \&unpackHash;
679             $packTable[PT_FILEREQUEST] = \&packHash;
680             # -------------------------------------------------------------------
681             $PacketTagName[PT_FILEREQANSWER] = 'File request answer';
682             $unpackTable[PT_FILEREQANSWER] = sub {
683             my ($hash, $fname);
684             defined($hash = &unpackHash) or return;
685             defined($fname = &unpackS) or return;
686             # return {Hash => $hash, Name => $fname};
687             return ($hash, $fname);
688             };
689             $packTable[PT_FILEREQANSWER] = sub {
690             my ($hash, $fname) = @_;
691             return packHash($hash) . packS($fname);
692             # my ($d) = @_;
693             # return packHash($d->{Hash}) . packS($d->{Name});
694             };
695             # -------------------------------------------------------------------
696             # -------------------------------------------------------------------
697             $PacketTagName[PT_UDP_SERVERSTATUSREQ] = 'UDP Server status request';
698             $unpackTable[PT_UDP_SERVERSTATUSREQ] = \&unpackD;
699             $packTable[PT_UDP_SERVERSTATUSREQ] = \&packD;
700             # -------------------------------------------------------------------
701             $PacketTagName[PT_UDP_SERVERSTATUS] = 'UDP Server status';
702             $unpackTable[PT_UDP_SERVERSTATUS] = sub {
703             my ($ip, $nusers, $nfiles);
704             defined($ip = &unpackD) or return;
705             defined($nusers = &unpackD) or return;
706             defined($nfiles = &unpackD) or return;
707             return ($ip, $nusers, $nfiles);
708             };
709             $packTable[PT_UDP_SERVERSTATUS] = sub {
710             return pack('LLL', @_);
711             };
712             # -------------------------------------------------------------------
713             $PacketTagName[PT_UDP_SEARCHFILE] = 'UDP Search file';
714             $unpackTable[PT_UDP_SEARCHFILE] = \&unpackSearchQuery;
715             $packTable[PT_UDP_SEARCHFILE] = \&packSearchQuery;
716             # -------------------------------------------------------------------
717             $PacketTagName[PT_UDP_SEARCHFILERES] = 'UDP Search file result';
718             $unpackTable[PT_UDP_SEARCHFILERES] = \&unpackInfo;
719             $packTable[PT_UDP_SEARCHFILERES] = \&packInfo;
720             # -------------------------------------------------------------------
721             $PacketTagName[PT_UDP_GETSOURCES] = 'UDP Get sources';
722             $unpackTable[PT_UDP_GETSOURCES] = \&unpackHash;
723             $packTable[PT_UDP_GETSOURCES] = \&packHash;
724             # -------------------------------------------------------------------
725             $PacketTagName[PT_UDP_FOUNDSOURCES] = 'UDP Found Sources';
726             $unpackTable[PT_UDP_FOUNDSOURCES] = $unpackFoundSources;
727             $packTable[PT_UDP_FOUNDSOURCES] = $packFoundSources;
728             # -------------------------------------------------------------------
729             $PacketTagName[PT_UDP_CBREQUEST] = 'UDP Callback request';
730             $unpackTable[PT_UDP_CBREQUEST] = sub {
731             my ($ip, $port, $cid);
732             ($ip, $port) = &unpackAddr or return;
733             defined($cid = &unpackD) or return;
734             return ($ip, $port, $cid);
735             };
736             $packTable[PT_UDP_CBREQUEST] = sub {
737             my ($ip, $port, $cid) = @_;
738             return packAddr($ip, $port) . packD($cid);
739             };
740             # -------------------------------------------------------------------
741             $PacketTagName[PT_UDP_CBFAIL] = 'UDP Callback fail';
742             $unpackTable[PT_UDP_CBFAIL] = \&unpackD;
743             $packTable[PT_UDP_CBFAIL] = \&packD;
744             # -------------------------------------------------------------------
745             $PacketTagName[PT_UDP_NEWSERVER] = 'UDP New server';
746             $unpackTable[PT_UDP_NEWSERVER] = \&unpackAddr;
747             $packTable[PT_UDP_NEWSERVER] = \&packAddr;
748             # -------------------------------------------------------------------
749             $PacketTagName[PT_UDP_SERVERLIST] = 'UDP Server list';
750             $unpackTable[PT_UDP_SERVERLIST] = \&unpackAddrList;
751             $packTable[PT_UDP_SERVERLIST] = \&packAddrList;
752             # -------------------------------------------------------------------
753             $PacketTagName[PT_UDP_GETSERVERINFO] = 'UDP Get server info';
754             $unpackTable[PT_UDP_GETSERVERINFO] = $unpackEmpty;
755             $packTable[PT_UDP_GETSERVERINFO] = $packEmpty;
756             # -------------------------------------------------------------------
757             $PacketTagName[PT_UDP_SERVERINFO] = 'UDP Server info';
758             $unpackTable[PT_UDP_SERVERINFO] = sub {
759             my ($name, $desc);
760             defined($name = &unpackS) or return;
761             defined($desc = &unpackS) or return;
762             return ($name, $desc);
763             };
764             $packTable[PT_UDP_SERVERINFO] = sub {
765             my ($name, $desc) = @_;
766             return packS($name) . packS($desc);
767             };
768             # -------------------------------------------------------------------
769             $PacketTagName[PT_UDP_GETSERVERLIST] = 'UDP Get server list';
770             $unpackTable[PT_UDP_GETSERVERLIST] = $unpackEmpty;
771             $packTable[PT_UDP_GETSERVERLIST] = $packEmpty;
772             # -------------------------------------------------------------------
773              
774             # -------------------------------------------------------------------
775             $PacketTagName[PT_ADM_LOGIN] = 'Adm Login';
776             $unpackTable[PT_ADM_LOGIN] = sub {
777             my ($user, $pass);
778             defined($user = &unpackS) or return;
779             defined($pass = &unpackS) or return;
780             return ($user, $pass);
781             };
782             $packTable[PT_ADM_LOGIN] = sub {
783             my ($user, $pass) = @_;
784             return packS($user) . packS($pass);
785             };
786             # -------------------------------------------------------------------
787             $PacketTagName[PT_ADM_STOP] = 'Adm Stop';
788             $unpackTable[PT_ADM_STOP] = $unpackEmpty;
789             $packTable[PT_ADM_STOP] = $packEmpty;
790             # -------------------------------------------------------------------
791             $PacketTagName[PT_ADM_COMMAND] = 'Adm Command';
792             $unpackTable[PT_ADM_COMMAND] = \&unpackS;
793             $packTable[PT_ADM_COMMAND] = \&packS;
794             # -------------------------------------------------------------------
795             $PacketTagName[PT_ADM_SERVER_LIST] = 'Adm Server list';
796             $unpackTable[PT_ADM_SERVER_LIST] = \&unpackInfoList;
797             $packTable[PT_ADM_SERVER_LIST] = \&packInfoList;
798             # -------------------------------------------------------------------
799             $PacketTagName[PT_ADM_FRIEND_LIST] = 'Adm Friend list';
800             $unpackTable[PT_ADM_FRIEND_LIST] = \&unpackInfoList;
801             $packTable[PT_ADM_FRIEND_LIST] = \&packInfoList;
802             # -------------------------------------------------------------------
803             $PacketTagName[PT_ADM_SHARED_DIRS] = 'Adm Shared dirs';
804             $unpackTable[PT_ADM_SHARED_DIRS] = \&unpackSList;
805             $packTable[PT_ADM_SHARED_DIRS] = \&packSList;
806             # -------------------------------------------------------------------
807             $PacketTagName[PT_ADM_SHARED_FILES] = 'Adm Shared files';
808             $unpackTable[PT_ADM_SHARED_FILES] = \&unpackInfoList;
809             $packTable[PT_ADM_SHARED_FILES] = \&packInfoList;
810             # -------------------------------------------------------------------
811             $PacketTagName[PT_ADM_GAP_DETAILS] = 'Adm Gap details';
812             $unpackTable[PT_ADM_GAP_DETAILS] = sub {
813             my ($hash, $l);
814             defined($hash = &unpackHash) or return;
815             $l = &unpackGapInfoList or return;
816             return ($hash, $l);
817             };
818             $packTable[PT_ADM_GAP_DETAILS] = sub {
819             my ($hash, $l) = @_;
820             return packHash($hash) . packGapInfoList($l);
821             };
822             # -------------------------------------------------------------------
823             $PacketTagName[PT_ADM_CORE_STATUS] = 'Adm Core status';
824             $unpackTable[PT_ADM_CORE_STATUS] = sub {
825             my ($temp, $incoming, $needed, $cid, $nconn, $nqueue);
826             defined($temp = &unpackF) or return;
827             defined($incoming = &unpackF) or return;
828             defined($needed = &unpackF) or return;
829             defined($cid = &unpackD) or return;
830             defined($nconn = &unpackW) or return;
831             defined($nqueue = &unpackW) or return;
832             return ($temp, $incoming, $needed, $cid, $nconn, $nqueue);
833             };
834             $packTable[PT_ADM_CORE_STATUS] = sub {
835             my ($temp, $incoming, $needed, $cid, $nconn, $nqueue) = @_;
836             return packF($temp) . packF($incoming) . packF($needed)
837             . packD($cid) . packW($nconn) . packW($nqueue);
838             };
839             # -------------------------------------------------------------------
840             $PacketTagName[PT_ADM_MESSAGE] = 'Adm Message';
841             $unpackTable[PT_ADM_MESSAGE] = \&unpackS;
842             $packTable[PT_ADM_MESSAGE] = \&packS;
843             # -------------------------------------------------------------------
844             $PacketTagName[PT_ADM_ERROR_MESSAGE] = 'Adm Error message';
845             $unpackTable[PT_ADM_ERROR_MESSAGE] = \&unpackS;
846             $packTable[PT_ADM_ERROR_MESSAGE] = \&packS;
847             # -------------------------------------------------------------------
848             $PacketTagName[PT_ADM_CONNECTED] = 'Adm Connected';
849             $unpackTable[PT_ADM_CONNECTED] = \&unpackS;
850             $packTable[PT_ADM_CONNECTED] = \&packS;
851             # -------------------------------------------------------------------
852             $PacketTagName[PT_ADM_DISCONNECTED] = 'Adm ';
853             $unpackTable[PT_ADM_DISCONNECTED] = $unpackEmpty;
854             $packTable[PT_ADM_DISCONNECTED] = $packEmpty;
855             # -------------------------------------------------------------------
856             $PacketTagName[PT_ADM_SERVER_STATUS] = 'Adm Server status';
857             $unpackTable[PT_ADM_SERVER_STATUS] = $unpackTable[PT_SERVERSTATUS];
858             $packTable[PT_ADM_SERVER_STATUS] = $packTable[PT_SERVERSTATUS];
859             # -------------------------------------------------------------------
860             $PacketTagName[PT_ADM_EXTENDING_SEARCH] = 'Adm Extending search';
861             $unpackTable[PT_ADM_EXTENDING_SEARCH] = \&unpackS;
862             $packTable[PT_ADM_EXTENDING_SEARCH] = \&packS;
863             # -------------------------------------------------------------------
864             $PacketTagName[PT_ADM_FILE_INFO] = 'Adm File info';
865             $unpackTable[PT_ADM_FILE_INFO] = \&unpackInfo;
866             $packTable[PT_ADM_FILE_INFO] = \&packInfo;
867             # -------------------------------------------------------------------
868             $PacketTagName[PT_ADM_SEARCH_FILE_RES] = 'Adm Search file results';
869             $unpackTable[PT_ADM_SEARCH_FILE_RES] = $unpackTable[PT_SEARCHFILERES];
870             $packTable[PT_ADM_SEARCH_FILE_RES] = $packTable[PT_SEARCHFILERES];
871             # -------------------------------------------------------------------
872             $PacketTagName[PT_ADM_NEW_DOWNLOAD] = 'Adm New download';
873             $unpackTable[PT_ADM_NEW_DOWNLOAD] = sub {
874             my ($info, $pri, $fname);
875             $info = &unpackInfo or return;
876             defined($pri = &unpackB) or return;
877             defined($fname = &unpackS) or return;
878             return ($info, $pri, $fname);
879             };
880             $packTable[PT_ADM_NEW_DOWNLOAD] = sub {
881             my ($info, $pri, $fname) = @_;
882             return packInfo($info) . packB($pri) . packS($fname);
883             };
884             # -------------------------------------------------------------------
885             $PacketTagName[PT_ADM_REMOVE_DOWNLOAD] = 'Adm Remove download';
886             $unpackTable[PT_ADM_REMOVE_DOWNLOAD] = \&unpackHash;
887             $packTable[PT_ADM_REMOVE_DOWNLOAD] = \&packHash;
888             # -------------------------------------------------------------------
889             $PacketTagName[PT_ADM_NEW_UPLOAD] = 'Adm New upload';
890             $unpackTable[PT_ADM_NEW_UPLOAD] = sub {
891             my ($fname, $cinfo);
892             defined($fname = &unpackS) or return;
893             $cinfo = &unpackInfo or return;
894             return ($fname, $cinfo);
895             };
896             $packTable[PT_ADM_NEW_UPLOAD] = sub {
897             my ($fname, $cinfo) = @_;
898             return packS($fname) . packInfo($cinfo);
899             };
900             # -------------------------------------------------------------------
901             $PacketTagName[PT_ADM_REMOVE_UPLOAD] = 'Adm Remove upload';
902             $unpackTable[PT_ADM_REMOVE_UPLOAD] = \&unpackHash;
903             $packTable[PT_ADM_REMOVE_UPLOAD] = \&packHash;
904             # -------------------------------------------------------------------
905             $PacketTagName[PT_ADM_NEW_UPLOAD_SLOT] = 'Adm New upload slot';
906             $unpackTable[PT_ADM_NEW_UPLOAD_SLOT] = sub {
907             my ($slot, $peername);
908             defined($slot = &unpackD) or return;
909             defined($peername = &unpackS) or return;
910             return ($slot, $peername);
911             };
912             $packTable[PT_ADM_NEW_UPLOAD_SLOT] = sub {
913             my ($slot, $peername) = @_;
914             return packD($slot) . packS($peername);
915             };
916             # -------------------------------------------------------------------
917             $PacketTagName[PT_ADM_REMOVE_UPLOAD_SLOT] = 'Adm Remove upload slot';
918             $unpackTable[PT_ADM_REMOVE_UPLOAD_SLOT] = \&unpackD;
919             $packTable[PT_ADM_REMOVE_UPLOAD_SLOT] = \&packD;
920             # -------------------------------------------------------------------
921             $PacketTagName[PT_ADM_FRIEND_FILES] = 'Adm Friend files';
922             #$unpackTable[PT_ADM_FRIEND_FILES] = $unpackEmpty;
923             #$packTable[PT_ADM_FRIEND_FILES] = $packEmpty;
924             # -------------------------------------------------------------------
925             $PacketTagName[PT_ADM_HASHING] = 'Adm Hashing';
926             $unpackTable[PT_ADM_HASHING] = \&unpackS;
927             $packTable[PT_ADM_HASHING] = \&packS;
928             # -------------------------------------------------------------------
929             $PacketTagName[PT_ADM_FRIEND_LIST_UPDATE] = 'Adm Friend list update';
930             #$unpackTable[PT_ADM_FRIEND_LIST_UPDATE] = $unpackEmpty;
931             #$packTable[PT_ADM_FRIEND_LIST_UPDATE] = $packEmpty;
932             # -------------------------------------------------------------------
933             $PacketTagName[PT_ADM_DOWNLOAD_STATUS] = 'Adm Download status';
934             $unpackTable[PT_ADM_DOWNLOAD_STATUS] = sub {
935             my ($len, $slot, $stat, $speed, $trans, $avail, $srcs, @res);
936             @res = ();
937             defined($len = &unpackW) or return;
938             while ($len--) {
939             defined($slot = &unpackW) or return;
940             defined($stat = &unpackB) or return;
941             defined($speed = &unpackF) or return;
942             defined($trans = &unpackD) or return;
943             defined($avail = &unpackB) or return;
944             defined($srcs = &unpackB) or return;
945             push @res, {Slot => $slot, Status => $stat, Speed => $speed,
946             Transferred => $trans, Availability => $avail,
947             Sources => $srcs};
948             }
949             return \@res;
950             };
951             $packTable[PT_ADM_DOWNLOAD_STATUS] = sub {
952             my ($l) = @_;
953             my $res = packW(scalar @$l);
954             foreach my $i (@$l) {
955             $res .= packW($i->{Slot})
956             . packB($i->{Status})
957             . packF($i->{Speed})
958             . packD($i->{Transferred})
959             . packB($i->{Availability})
960             . packB($i->{Sources});
961             }
962             return $res;
963             };
964             # -------------------------------------------------------------------
965             $PacketTagName[PT_ADM_UPLOAD_STATUS] = 'Adm Upload status';
966             $unpackTable[PT_ADM_UPLOAD_STATUS] = sub {
967             my ($len, $slot, $speed, @res);
968             @res = ();
969             defined($len = &unpackW) or return;
970             while ($len--) {
971             defined($slot = &unpackW) or return;
972             defined($speed = &unpackF) or return;
973             push @res, {Slot => $slot, Speed => $speed};
974             }
975             return \@res;
976             };
977             $packTable[PT_ADM_UPLOAD_STATUS] = sub {
978             my ($l) = @_;
979             my $res = packW(scalar @$l);
980             foreach my $i (@$l) {
981             $res .= packW($i->{Slot})
982             . packF($i->{Speed});
983             }
984             return $res;
985             };
986             # -------------------------------------------------------------------
987             $PacketTagName[PT_ADM_OPTIONS] = 'Adm Options';
988             $unpackTable[PT_ADM_OPTIONS] = sub {
989             my ($ver, $maxDL, $maxUL, $port, $maxCon, $nick,
990             $temp, $incoming, $auto, $rdead, $privmsg, $savecor,
991             $verif, $admport, $cbd, $lines, $pid, $maxNUp);
992             defined($ver = &unpackW) or return;
993             defined($maxDL = &unpackF) or return;
994             defined($maxUL = &unpackF) or return;
995             defined($port = &unpackW) or return;
996             defined($maxNUp = &unpackW) or return;
997             defined($nick = &unpackS) or return;
998             defined($temp = &unpackS) or return;
999             defined($incoming = &unpackS) or return;
1000             defined($auto = &unpackB) or return;
1001             defined($rdead = &unpackB) or return;
1002             defined($privmsg= &unpackB) or return;
1003             defined($savecor= &unpackB) or return;
1004             defined($verif = &unpackB) or return;
1005             defined($admport= &unpackW) or return;
1006             defined($maxCon = &unpackD) or return;
1007             defined($cbd = &unpackD) or return;
1008             defined($lines = &unpackF) or return;
1009             defined($pid = &unpackD) or return;
1010             return {
1011             Version => $ver,
1012             userMaxDownF => $maxDL,
1013             userMaxUpF => $maxUL,
1014             incomingPort => $port,
1015             maxNumUp => $maxNUp,
1016             Nickname => $nick,
1017             temp => $temp,
1018             incoming => $incoming,
1019             auto => $auto,
1020             servRemove => $rdead,
1021             pmAllow => $privmsg,
1022             saveCor => $savecor,
1023             verifyCancel => $verif,
1024             adminDoorPort => $admport,
1025             maxCon => $maxCon,
1026             cbd => $cbd,
1027             lineDown => $lines,
1028             PID => $pid
1029             };
1030             };
1031             $packTable[PT_ADM_OPTIONS] = sub {
1032             my ($p) = @_;
1033             return
1034             packW($p->{Version})
1035             . packF($p->{userMaxDownF})
1036             . packF($p->{userMaxUpF})
1037             . packW($p->{incomingPort})
1038             . packW($p->{maxNumUp})
1039             . packS($p->{Nickname})
1040             . packS($p->{temp})
1041             . packS($p->{incoming})
1042             . packB($p->{auto})
1043             . packB($p->{servRemove})
1044             . packB($p->{pmAllow})
1045             . packB($p->{saveCor})
1046             . packB($p->{verifyCancel})
1047             . packW($p->{adminDoorPort})
1048             . packD($p->{maxCon})
1049             . packD($p->{cbd})
1050             . packF($p->{lineDown})
1051             . packD($p->{PID})
1052             };
1053             # -------------------------------------------------------------------
1054             $PacketTagName[PT_ADM_CONNECT] = 'Adm Connect';
1055             $unpackTable[PT_ADM_CONNECT] = \&unpackAddr;
1056             $packTable[PT_ADM_CONNECT] = \&packAddr;
1057             # -------------------------------------------------------------------
1058             $PacketTagName[PT_ADM_DISCONNECT] = 'Adm Disconnect';
1059             $unpackTable[PT_ADM_DISCONNECT] = $unpackEmpty;
1060             $packTable[PT_ADM_DISCONNECT] = $packEmpty;
1061             # -------------------------------------------------------------------
1062             $PacketTagName[PT_ADM_SEARCH_FILE] = 'Adm Search file';
1063             $unpackTable[PT_ADM_SEARCH_FILE] = \&unpackSearchQuery;
1064             $packTable[PT_ADM_SEARCH_FILE] = \&packSearchQuery;
1065             # -------------------------------------------------------------------
1066             $PacketTagName[PT_ADM_EXTEND_SEARCH_FILE] = 'Adm Extend search file';
1067             $unpackTable[PT_ADM_EXTEND_SEARCH_FILE] = $unpackEmpty;
1068             $packTable[PT_ADM_EXTEND_SEARCH_FILE] = $packEmpty;
1069             # -------------------------------------------------------------------
1070             $PacketTagName[PT_ADM_MORE_RESULTS] = 'Adm More results';
1071             $unpackTable[PT_ADM_MORE_RESULTS] = $unpackEmpty;
1072             $packTable[PT_ADM_MORE_RESULTS] = $packEmpty;
1073             # -------------------------------------------------------------------
1074             $PacketTagName[PT_ADM_SEARCH_USER] = 'Adm Search user';
1075             $unpackTable[PT_ADM_SEARCH_USER] = \&unpackSearchQuery;
1076             $packTable[PT_ADM_SEARCH_USER] = \&packSearchQuery;
1077             # -------------------------------------------------------------------
1078             $PacketTagName[PT_ADM_EXTEND_SEARCH_USER] = 'Adm Extend search user';
1079             $unpackTable[PT_ADM_EXTEND_SEARCH_USER] = $unpackEmpty;
1080             $packTable[PT_ADM_EXTEND_SEARCH_USER] = $packEmpty;
1081             # -------------------------------------------------------------------
1082             $PacketTagName[PT_ADM_DOWNLOAD] = 'Adm Download';
1083             $unpackTable[PT_ADM_DOWNLOAD] = \&unpackHash;
1084             $packTable[PT_ADM_DOWNLOAD] = \&packHash;
1085             # -------------------------------------------------------------------
1086             $PacketTagName[PT_ADM_PAUSE_DOWNLOAD] = 'Adm Pause download';
1087             $unpackTable[PT_ADM_PAUSE_DOWNLOAD] = \&unpackHash;
1088             $packTable[PT_ADM_PAUSE_DOWNLOAD] = \&packHash;
1089             # -------------------------------------------------------------------
1090             $PacketTagName[PT_ADM_RESUME_DOWNLOAD] = 'Adm Resume download';
1091             $unpackTable[PT_ADM_RESUME_DOWNLOAD] = \&unpackHash;
1092             $packTable[PT_ADM_RESUME_DOWNLOAD] = \&packHash;
1093             # -------------------------------------------------------------------
1094             $PacketTagName[PT_ADM_CANCEL_DOWNLOAD] = 'Adm Cancel download';
1095             $unpackTable[PT_ADM_CANCEL_DOWNLOAD] = \&unpackHash;
1096             $packTable[PT_ADM_CANCEL_DOWNLOAD] = \&packHash;
1097             # -------------------------------------------------------------------
1098             $PacketTagName[PT_ADM_SET_FILE_PRI] = 'Adm Set file priority';
1099             $unpackTable[PT_ADM_SET_FILE_PRI] = sub {
1100             my ($hash, $pri);
1101             defined($hash = &unpackHash) or return;
1102             defined($pri = &unpackB) or return;
1103             return ($hash, $pri);
1104             };
1105             $packTable[PT_ADM_SET_FILE_PRI] = sub {
1106             my ($hash, $pri) = @_;
1107             return packHash($hash) . packB($pri);
1108             };
1109             # -------------------------------------------------------------------
1110             $PacketTagName[PT_ADM_VIEW_FRIEND_FILES] = 'Adm View friend files';
1111             #$unpackTable[PT_ADM_VIEW_FRIEND_FILES] = $unpackEmpty;
1112             #$packTable[PT_ADM_VIEW_FRIEND_FILES] = $packEmpty;
1113             # -------------------------------------------------------------------
1114             $PacketTagName[PT_ADM_GET_SERVER_LIST] = 'Adm Get server list';
1115             $unpackTable[PT_ADM_GET_SERVER_LIST] = $unpackEmpty;
1116             $packTable[PT_ADM_GET_SERVER_LIST] = $packEmpty;
1117             # -------------------------------------------------------------------
1118             $PacketTagName[PT_ADM_GET_CLIENT_LIST] = 'Adm Get client list';
1119             $unpackTable[PT_ADM_GET_CLIENT_LIST] = $unpackEmpty;
1120             $packTable[PT_ADM_GET_CLIENT_LIST] = $packEmpty;
1121             # -------------------------------------------------------------------
1122             $PacketTagName[PT_ADM_GET_SHARED_DIRS] = 'Adm Get shared dirs';
1123             $unpackTable[PT_ADM_GET_SHARED_DIRS] = $unpackEmpty;
1124             $packTable[PT_ADM_GET_SHARED_DIRS] = $packEmpty;
1125             # -------------------------------------------------------------------
1126             $PacketTagName[PT_ADM_SET_SHARED_DIRS] = 'Adm Set shared dirs';
1127             #$unpackTable[PT_ADM_SET_SHARED_DIRS] = $unpackEmpty;
1128             #$packTable[PT_ADM_SET_SHARED_DIRS] = $packEmpty;
1129             # -------------------------------------------------------------------
1130             $PacketTagName[PT_ADM_START_DL_STATUS] = 'Adm Start dl status';
1131             $unpackTable[PT_ADM_START_DL_STATUS] = $unpackEmpty;
1132             $packTable[PT_ADM_START_DL_STATUS] = $packEmpty;
1133             # -------------------------------------------------------------------
1134             $PacketTagName[PT_ADM_STOP_DL_STATUS] = 'Adm Stop dl status';
1135             $unpackTable[PT_ADM_STOP_DL_STATUS] = $unpackEmpty;
1136             $packTable[PT_ADM_STOP_DL_STATUS] = $packEmpty;
1137             # -------------------------------------------------------------------
1138             $PacketTagName[PT_ADM_START_UL_STATUS] = 'Adm Start ul status';
1139             $unpackTable[PT_ADM_START_UL_STATUS] = $unpackEmpty;
1140             $packTable[PT_ADM_START_UL_STATUS] = $packEmpty;
1141             # -------------------------------------------------------------------
1142             $PacketTagName[PT_ADM_STOP_UL_STATUS] = 'Adm Stop ul status';
1143             $unpackTable[PT_ADM_STOP_UL_STATUS] = $unpackEmpty;
1144             $packTable[PT_ADM_STOP_UL_STATUS] = $packEmpty;
1145             # -------------------------------------------------------------------
1146             $PacketTagName[PT_ADM_DELETE_SERVER] = 'Adm Delete server';
1147             $unpackTable[PT_ADM_DELETE_SERVER] = \&unpackAddr;
1148             $packTable[PT_ADM_DELETE_SERVER] = \&packAddr;
1149             # -------------------------------------------------------------------
1150             $PacketTagName[PT_ADM_ADD_SERVER] = 'Adm Add server';
1151             $unpackTable[PT_ADM_ADD_SERVER] = \&unpackAddr;
1152             $packTable[PT_ADM_ADD_SERVER] = \&packAddr;
1153             # -------------------------------------------------------------------
1154             $PacketTagName[PT_ADM_SET_SERVER_PRI] = 'Adm Set server pri';
1155             $unpackTable[PT_ADM_SET_SERVER_PRI] = sub {
1156             my ($ip, $port, $pri);
1157             ($ip, $port) = &unpackAddr or return;
1158             defined($pri = &unpackB) or return;
1159             return ($ip, $port, $pri);
1160             };
1161             $packTable[PT_ADM_SET_SERVER_PRI] = sub {
1162             my ($ip, $port, $pri) = @_;
1163             return packAddr($ip, $port) . packB($pri);
1164             };
1165             # -------------------------------------------------------------------
1166             $PacketTagName[PT_ADM_GET_SHARED_FILES] = 'Adm Get shared files';
1167             $unpackTable[PT_ADM_GET_SHARED_FILES] = $unpackEmpty;
1168             $packTable[PT_ADM_GET_SHARED_FILES] = $packEmpty;
1169             # -------------------------------------------------------------------
1170             $PacketTagName[PT_ADM_GET_OPTIONS] = 'Adm Get options';
1171             $unpackTable[PT_ADM_GET_OPTIONS] = $unpackEmpty;
1172             $packTable[PT_ADM_GET_OPTIONS] = $packEmpty;
1173             # -------------------------------------------------------------------
1174             $PacketTagName[PT_ADM_DOWNLOAD_FILE] = 'Adm Download file';
1175             $unpackTable[PT_ADM_DOWNLOAD_FILE] = \&unpackInfo;
1176             $packTable[PT_ADM_DOWNLOAD_FILE] = \&packInfo;
1177             # -------------------------------------------------------------------
1178             $PacketTagName[PT_ADM_GET_GAP_DETAILS] = 'Adm Get gap details';
1179             $unpackTable[PT_ADM_GET_GAP_DETAILS] = sub {
1180             my ($hash);
1181             defined($hash = &unpackHash) or return;
1182             &unpackB;
1183             return $hash;
1184             };
1185             $packTable[PT_ADM_GET_GAP_DETAILS] = sub {
1186             return &packHash . packB(0);
1187             };
1188             # -------------------------------------------------------------------
1189             $PacketTagName[PT_ADM_GET_CORE_STATUS] = 'Adm Get core status';
1190             $unpackTable[PT_ADM_GET_CORE_STATUS] = $unpackEmpty;
1191             $packTable[PT_ADM_GET_CORE_STATUS] = $packEmpty;
1192              
1193             sub unpackGapInfo {
1194 0     0 0   my ($start, $end, $val);
1195 0 0         defined($start = &unpackD) or return;
1196 0 0         defined($end = &unpackD) or return;
1197 0 0         defined($val = &unpackW) or return;
1198 0           return {Start => $start, End => $end, Status => $val};
1199             }
1200             sub packGapInfo {
1201 0     0 0   my ($d) = @_;
1202 0           return packD($d->{Start}) . packD($d->{End}) . packW($d->{Status});
1203             }
1204              
1205             sub unpackGapInfoList {
1206 0     0 0   my (@res, $len, $s);
1207 0           @res = ();
1208 0 0         defined($len = &unpackW) or return;
1209 0           while ($len--) {
1210 0 0         defined($s = &unpackGapInfo) or return;
1211 0           push @res, $s;
1212             }
1213 0           return \@res;
1214             }
1215             sub packGapInfoList {
1216 0     0 0   my ($l) = @_;
1217 0           my ($res, $e);
1218 0           $res = packW(scalar @$l);
1219 0           foreach $e (@$l) {
1220 0           $res .= packGapInfo($e);
1221             }
1222 0           return $res;
1223             }
1224              
1225             1;
1226             __END__