… | |
… | |
31 | package Net::FCP; |
31 | package Net::FCP; |
32 | |
32 | |
33 | use Carp; |
33 | use Carp; |
34 | use IO::Socket::INET; |
34 | use IO::Socket::INET; |
35 | |
35 | |
36 | $VERSION = 0.01; |
36 | $VERSION = 0.02; |
37 | |
37 | |
38 | sub event_reg_cb { |
38 | sub event_reg_cb { |
39 | my ($obj) = @_; |
39 | my ($obj) = @_; |
40 | require Event; |
40 | require Event; |
41 | |
41 | |
… | |
… | |
59 | |
59 | |
60 | $regcb = \&event_reg_cb; |
60 | $regcb = \&event_reg_cb; |
61 | $unregcb = \&event_unreg_cb; |
61 | $unregcb = \&event_unreg_cb; |
62 | $waitcb = \&event_wait_cb; |
62 | $waitcb = \&event_wait_cb; |
63 | |
63 | |
|
|
64 | sub touc($) { |
|
|
65 | local $_ = shift; |
|
|
66 | 1 while s/((?:^|_)(?:svk|chk|uri)(?:_|$))/\U$1/; |
|
|
67 | s/(?:^|_)(.)/\U$1/g; |
|
|
68 | $_; |
|
|
69 | } |
|
|
70 | |
|
|
71 | sub tolc($) { |
|
|
72 | local $_ = shift; |
|
|
73 | s/(?<=[a-z])(?=[A-Z])/_/g; |
|
|
74 | lc $_; |
|
|
75 | } |
|
|
76 | |
64 | =item $fcp = new Net::FCP [host => $host][, port => $port] |
77 | =item $fcp = new Net::FCP [host => $host][, port => $port] |
65 | |
78 | |
66 | Create a new virtual FCP connection to the given host and port (default |
79 | Create a new virtual FCP connection to the given host and port (default |
67 | 127.0.0.1:8481). |
80 | 127.0.0.1:8481). |
68 | |
81 | |
… | |
… | |
92 | =cut |
105 | =cut |
93 | |
106 | |
94 | sub txn { |
107 | sub txn { |
95 | my ($self, $type, %attr) = @_; |
108 | my ($self, $type, %attr) = @_; |
96 | |
109 | |
|
|
110 | $type = touc $type; |
|
|
111 | |
97 | my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => $type, attr => \%attr); |
112 | my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr); |
98 | |
113 | |
99 | $txn; |
114 | $txn; |
100 | } |
115 | } |
101 | |
116 | |
102 | sub _txn($&) { |
117 | sub _txn($&) { |
… | |
… | |
110 | =item $nodehello = $fcp->client_hello |
125 | =item $nodehello = $fcp->client_hello |
111 | |
126 | |
112 | Executes a ClientHello request and returns it's results. |
127 | Executes a ClientHello request and returns it's results. |
113 | |
128 | |
114 | { |
129 | { |
115 | MaxFileSize => "5f5e100", |
130 | max_file_size => "5f5e100", |
116 | Protocol => "1.2", |
|
|
117 | Node => "Fred,0.6,1.46,7050" |
131 | node => "Fred,0.6,1.46,7050" |
|
|
132 | protocol => "1.2", |
118 | } |
133 | } |
119 | |
134 | |
120 | =cut |
135 | =cut |
121 | |
136 | |
122 | _txn client_hello => sub { |
137 | _txn client_hello => sub { |
123 | my ($self) = @_; |
138 | my ($self) = @_; |
124 | |
139 | |
125 | $self->txn ("ClientHello"); |
140 | $self->txn ("client_hello"); |
126 | }; |
141 | }; |
127 | |
142 | |
128 | =item $txn = $fcp->txn_client_info |
143 | =item $txn = $fcp->txn_client_info |
129 | |
144 | |
130 | =item $nodeinfo = $fcp->client_info |
145 | =item $nodeinfo = $fcp->client_info |
131 | |
146 | |
132 | Executes a ClientInfo request and returns it's results. |
147 | Executes a ClientInfo request and returns it's results. |
133 | |
148 | |
134 | { |
149 | { |
135 | MaxFileSize => "5f5e100", |
|
|
136 | DatastoreMax => "2540be400", |
|
|
137 | NodePort => 369, |
|
|
138 | JavaName => "Java HotSpot(TM) Server VM", |
|
|
139 | OperatingSystemVersion => "2.4.20", |
|
|
140 | EstimatedLoad => 52, |
|
|
141 | FreeMemory => "5cc0148", |
|
|
142 | DatastoreFree => "5ce03400", |
|
|
143 | NodeAddress => "1.2.3.4", |
|
|
144 | ActiveJobs => "1f", |
150 | active_jobs => "1f", |
145 | AllocatedMemory => "bde0000", |
151 | allocated_memory => "bde0000", |
146 | Architecture => "i386", |
152 | architecture => "i386", |
147 | RoutingTime => "a5", |
|
|
148 | LeastRecentTimestamp => "f41538b878", |
|
|
149 | AvailableThreads => 17, |
153 | available_threads => 17, |
|
|
154 | datastore_free => "5ce03400", |
|
|
155 | datastore_max => "2540be400", |
150 | DatastoreUsed => "1f72bb000", |
156 | datastore_used => "1f72bb000", |
151 | JavaVersion => "Blackdown-1.4.1-01", |
157 | estimated_load => 52, |
|
|
158 | free_memory => "5cc0148", |
152 | IsTransient => "false", |
159 | is_transient => "false", |
153 | OperatingSystem => "Linux", |
160 | java_name => "Java HotSpot(_T_M) Server VM", |
154 | JavaVendor => "http://www.blackdown.org/", |
161 | java_vendor => "http://www.blackdown.org/", |
|
|
162 | java_version => "Blackdown-1.4.1-01", |
|
|
163 | least_recent_timestamp => "f41538b878", |
|
|
164 | max_file_size => "5f5e100", |
155 | MostRecentTimestamp => "f77e2cc520" |
165 | most_recent_timestamp => "f77e2cc520" |
|
|
166 | node_address => "1.2.3.4", |
|
|
167 | node_port => 369, |
|
|
168 | operating_system => "Linux", |
|
|
169 | operating_system_version => "2.4.20", |
|
|
170 | routing_time => "a5", |
156 | } |
171 | } |
157 | |
172 | |
158 | =cut |
173 | =cut |
159 | |
174 | |
160 | _txn client_info => sub { |
175 | _txn client_info => sub { |
161 | my ($self) = @_; |
176 | my ($self) = @_; |
162 | |
177 | |
163 | $self->txn ("ClientInfo"); |
178 | $self->txn ("client_info"); |
164 | }; |
179 | }; |
165 | |
180 | |
166 | =item $txn = $fcp->txn_generate_chk ($metadata, $data) |
181 | =item $txn = $fcp->txn_generate_chk ($metadata, $data) |
167 | |
182 | |
168 | =item $uri = $fcp->generate_chk ($metadata, $data) |
183 | =item $uri = $fcp->generate_chk ($metadata, $data) |
… | |
… | |
172 | =cut |
187 | =cut |
173 | |
188 | |
174 | _txn generate_chk => sub { |
189 | _txn generate_chk => sub { |
175 | my ($self, $metadata, $data) = @_; |
190 | my ($self, $metadata, $data) = @_; |
176 | |
191 | |
177 | $self->txn (GenerateCHK => data => "$data$metadata", MetaDataLength => length $metadata); |
192 | $self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata); |
178 | }; |
193 | }; |
179 | |
194 | |
180 | =item $txn = $fcp->txn_generate_svk_pair |
195 | =item $txn = $fcp->txn_generate_svk_pair |
181 | |
196 | |
182 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
197 | =item ($public, $private) = @{ $fcp->generate_svk_pair } |
… | |
… | |
191 | =cut |
206 | =cut |
192 | |
207 | |
193 | _txn generate_svk_pair => sub { |
208 | _txn generate_svk_pair => sub { |
194 | my ($self) = @_; |
209 | my ($self) = @_; |
195 | |
210 | |
196 | $self->txn ("GenerateSVKPair"); |
211 | $self->txn ("generate_svk_pair"); |
197 | }; |
212 | }; |
198 | |
213 | |
199 | =item $txn = $fcp->txn_insert_private_key ($private) |
214 | =item $txn = $fcp->txn_insert_private_key ($private) |
200 | |
215 | |
201 | =item $uri = $fcp->insert_private_key ($private) |
216 | =item $uri = $fcp->insert_private_key ($private) |
… | |
… | |
211 | =cut |
226 | =cut |
212 | |
227 | |
213 | _txn insert_private_key => sub { |
228 | _txn insert_private_key => sub { |
214 | my ($self, $privkey) = @_; |
229 | my ($self, $privkey) = @_; |
215 | |
230 | |
216 | $self->txn (InvertPrivateKey => Private => $privkey); |
231 | $self->txn (invert_private_key => private => $privkey); |
217 | }; |
232 | }; |
218 | |
233 | |
219 | =item $txn = $fcp->txn_get_size ($uri) |
234 | =item $txn = $fcp->txn_get_size ($uri) |
220 | |
235 | |
221 | =item $length = $fcp->get_size ($uri) |
236 | =item $length = $fcp->get_size ($uri) |
… | |
… | |
228 | =cut |
243 | =cut |
229 | |
244 | |
230 | _txn get_size => sub { |
245 | _txn get_size => sub { |
231 | my ($self, $uri) = @_; |
246 | my ($self, $uri) = @_; |
232 | |
247 | |
233 | $self->txn (GetSize => URI => $uri); |
248 | $self->txn (get_size => URI => $uri); |
234 | }; |
249 | }; |
235 | |
250 | |
236 | =item MISSING: ClientGet, ClientPut |
251 | =item MISSING: ClientGet, ClientPut |
237 | |
252 | |
238 | =back |
253 | =back |
… | |
… | |
266 | |
281 | |
267 | my $attr = ""; |
282 | my $attr = ""; |
268 | my $data = delete $self->{attr}{data}; |
283 | my $data = delete $self->{attr}{data}; |
269 | |
284 | |
270 | while (my ($k, $v) = each %{$self->{attr}}) { |
285 | while (my ($k, $v) = each %{$self->{attr}}) { |
271 | $attr .= "$k=$v\012" |
286 | $attr .= (Net::FCP::touc $k) . "=$v\012" |
272 | } |
287 | } |
273 | |
288 | |
274 | if (defined $data) { |
289 | if (defined $data) { |
275 | $attr .= "DataLength=" . (length $data) . "\012"; |
290 | $attr .= "DataLength=" . (length $data) . "\012"; |
276 | $data = "Data\012$data"; |
291 | $data = "Data\012$data"; |
… | |
… | |
283 | PeerPort => $self->{fcp}{port} |
298 | PeerPort => $self->{fcp}{port} |
284 | or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; |
299 | or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n"; |
285 | |
300 | |
286 | binmode $fh, ":raw"; |
301 | binmode $fh, ":raw"; |
287 | |
302 | |
|
|
303 | if (0) { |
288 | print |
304 | print |
289 | $self->{type}, "\012", |
305 | Net::FCP::touc $self->{type}, "\012", |
290 | $attr, |
306 | $attr, |
291 | $data, "\012"; |
307 | $data, "\012"; |
|
|
308 | } |
292 | |
309 | |
293 | print $fh |
310 | print $fh |
294 | "\x00\x00", "\x00\x02", # SESSID, PRESID |
311 | "\x00\x00", "\x00\x02", # SESSID, PRESID |
295 | $self->{type}, "\012", |
312 | Net::FCP::touc $self->{type}, "\012", |
296 | $attr, |
313 | $attr, |
297 | $data; |
314 | $data; |
298 | |
315 | |
299 | #$fh->shutdown (1); # freenet buggy?, well, it's java... |
316 | #$fh->shutdown (1); # freenet buggy?, well, it's java... |
300 | |
317 | |
… | |
… | |
317 | last; |
334 | last; |
318 | } |
335 | } |
319 | } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) { |
336 | } elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) { |
320 | $self->{datalen} = $1; |
337 | $self->{datalen} = $1; |
321 | } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) { |
338 | } elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) { |
322 | $self->rcv ($1, {map { split /=/, $_, 2 } split /\015?\012/, $2}); |
339 | $self->rcv ($1, { |
|
|
340 | map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) } |
|
|
341 | split /\015?\012/, $2 |
|
|
342 | }); |
323 | } else { |
343 | } else { |
324 | last; |
344 | last; |
325 | } |
345 | } |
326 | } |
346 | } |
327 | } else { |
347 | } else { |
… | |
… | |
335 | my ($self, $chunk) = @_; |
355 | my ($self, $chunk) = @_; |
336 | } |
356 | } |
337 | |
357 | |
338 | sub rcv { |
358 | sub rcv { |
339 | my ($self, $type, $attr) = @_; |
359 | my ($self, $type, $attr) = @_; |
340 | #use PApp::Util;warn "$type => ".PApp::Util::dumpval($attr); |
|
|
341 | |
360 | |
|
|
361 | $type = Net::FCP::tolc $type; |
|
|
362 | |
342 | if (my $method = $self->can("rcv_\L$type")) { |
363 | if (my $method = $self->can("rcv_$type")) { |
343 | $method->($self, $attr, $type); |
364 | $method->($self, $attr, $type); |
344 | } else { |
365 | } else { |
345 | warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; |
366 | warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n"; |
346 | $self->eof; |
367 | $self->eof; |
347 | } |
368 | } |
… | |
… | |
376 | |
397 | |
377 | package Net::FCP::Txn::ClientHello; |
398 | package Net::FCP::Txn::ClientHello; |
378 | |
399 | |
379 | use base Net::FCP::Txn; |
400 | use base Net::FCP::Txn; |
380 | |
401 | |
381 | sub rcv_nodehello { |
402 | sub rcv_node_hello { |
382 | my ($self, $attr) = @_; |
403 | my ($self, $attr) = @_; |
383 | |
404 | |
384 | $self->eof ($attr); |
405 | $self->eof ($attr); |
385 | } |
406 | } |
386 | |
407 | |
387 | package Net::FCP::Txn::ClientInfo; |
408 | package Net::FCP::Txn::ClientInfo; |
388 | |
409 | |
389 | use base Net::FCP::Txn; |
410 | use base Net::FCP::Txn; |
390 | |
411 | |
391 | sub rcv_nodeinfo { |
412 | sub rcv_node_info { |
392 | my ($self, $attr) = @_; |
413 | my ($self, $attr) = @_; |
393 | |
414 | |
394 | $self->eof ($attr); |
415 | $self->eof ($attr); |
395 | } |
416 | } |
396 | |
417 | |