[ViewVC] Diff of: cvs/Net-FCP/FCP.pm

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC vs.
Revision 1.30 by root, Fri May 14 16:12:26 2004 UTC

…		…
35	The import tag to use is named C<event=xyz>, e.g. C<event=Event>,	35	The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
36	C<event=Glib> etc.	36	C<event=Glib> etc.
37		37
38	You should specify the event module to use only in the main program.	38	You should specify the event module to use only in the main program.
39		39
		40	If no event model has been specified, FCP tries to autodetect it on first
		41	use (e.g. first transaction), in this order: Coro, Event, Glib, Tk.
		42
		43	=head2 FREENET BASICS
		44
		45	Ok, this section will not explain any freenet basics to you, just some
		46	problems I found that you might want to avoid:
		47
		48	=over 4
		49
		50	=item freenet URIs are _NOT_ URIs
		51
		52	Whenever a "uri" is required by the protocol, freenet expects a kind of
		53	URI prefixed with the "freenet:" scheme, e.g. "freenet:CHK...". However,
		54	these are not URIs, as freeent fails to parse them correctly, that is, you
		55	must unescape an escaped characters ("%2c" => ",") yourself. Maybe in the
		56	future this library will do it for you, so watch out for this incompatible
		57	change.
		58
		59	=item Numbers are in HEX
		60
		61	Virtually every number in the FCP protocol is in hex. Be sure to use
		62	C<hex()> on all such numbers, as the module (currently) does nothing to
		63	convert these for you.
		64
		65	=back
		66
40	=head2 THE Net::FCP CLASS	67	=head2 THE Net::FCP CLASS
41		68
42	=over 4	69	=over 4
43		70
44	=cut	71	=cut
45		72
46	package Net::FCP;	73	package Net::FCP;
47		74
48	use Carp;	75	use Carp;
49		76
50	$VERSION = 0.05;	77	$VERSION = 0.7;
51		78
52	no warnings;	79	no warnings;
53		80
		81	use Net::FCP::Metadata;
		82
54	our $EVENT = Net::FCP::Event::Auto::;	83	our $EVENT = Net::FCP::Event::Auto::;
55	$EVENT = Net::FCP::Event::Event;#d#
56		84
57	sub import {	85	sub import {
58	shift;	86	shift;
59		87
60	for (@_) {	88	for (@_) {
61	if (/^event=(\w+)$/) {	89	if (/^event=(\w+)$/) {
62	$EVENT = "Net::FCP::Event::$1";	90	$EVENT = "Net::FCP::Event::$1";
		91	eval "require $EVENT";
63	}	92	}
64	}	93	}
65	eval "require $EVENT";
66	die $@ if $@;	94	die $@ if $@;
67	}	95	}
68		96
69	sub touc($) {	97	sub touc($) {
70	local $_ = shift;	98	local $_ = shift;
…		…
73	$_;	101	$_;
74	}	102	}
75		103
76	sub tolc($) {	104	sub tolc($) {
77	local $_ = shift;	105	local $_ = shift;
		106	1 while s/(SVK\|CHK\|URI)([^_])/$1\_$2/i;
		107	1 while s/([^_])(SVK\|CHK\|URI)/$1\_$2/i;
78	s/(?<=[a-z])(?=[A-Z])/_/g;	108	s/(?<=[a-z])(?=[A-Z])/_/g;
79	lc $_;	109	lc $_;
80	}	110	}
81		111
82	=item $meta = Net::FCP::parse_metadata $string	112	# the opposite of hex
83		113	sub xeh($) {
84	Parse a metadata string and return it.	114	sprintf "%x", $_[0];
85
86	The metadata will be a hashref with key C<version> (containing
87	the mandatory version header entries).
88
89	All other headers are represented by arrayrefs (they can be repeated).
90
91	Since this is confusing, here is a rather verbose example of a parsed
92	manifest:
93
94	(
95	version => { revision => 1 },
96	document => [
97	{
98	"info.format" => "image/jpeg",
99	name => "background.jpg",
100	"redirect.target" => "freenet:CHK\@ZcagI,ra726bSw"
101	},
102	{
103	"info.format" => "text/html",
104	name => ".next",
105	"redirect.target" => "freenet:SSK\@ilUPAgM/TFEE/3"
106	},
107	{
108	"info.format" => "text/html",
109	"redirect.target" => "freenet:CHK\@8M8Po8ucwI,8xA"
110	}
111	]
112	)
113
114	=cut
115
116	sub parse_metadata {
117	my $meta;
118
119	my $data = shift;
120	if ($data =~ /^Version\015?\012/gc) {
121	my $hdr = $meta->{version} = {};
122
123	for (;;) {
124	while ($data =~ /\G([^=\015\012]+)=([^\015\012]*)\015?\012/gc) {
125	my ($k, $v) = ($1, $2);
126	my @p = split /\./, tolc $k, 3;
127
128	$hdr->{$p[0]} = $v if @p == 1; # lamest code I ever wrote
129	$hdr->{$p[0]}{$p[1]} = $v if @p == 2;
130	$hdr->{$p[0]}{$p[1]}{$p[3]} = $v if @p == 3;
131	die "FATAL: 4+ dot metadata" if @p >= 4;
132	}
133
134	if ($data =~ /\GEndPart\015?\012/gc) {
135	# nop
136	} elsif ($data =~ /\GEnd\015?\012/gc) {
137	last;
138	} elsif ($data =~ /\G([A-Za-z0-9.\-]+)\015?\012/gcs) {
139	push @{$meta->{tolc $1}}, $hdr = {};
140	} elsif ($data =~ /\G(.*)/gcs) {
141	die "metadata format error ($1)";
142	}
143	}
144	}
145
146	#$meta->{tail} = substr $data, pos $data;
147
148	$meta;
149	}	115	}
150		116
151	=item $fcp = new Net::FCP [host => $host][, port => $port]	117	=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
152		118
153	Create a new virtual FCP connection to the given host and port (default	119	Create a new virtual FCP connection to the given host and port (default
154	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).	120	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
155		121
156	Connections are virtual because no persistent physical connection is	122	Connections are virtual because no persistent physical connection is
157	established. However, the existance of the node is checked by executing a	123	established.
158	C<ClientHello> transaction.	124
		125	You can install a progress callback that is being called with the Net::FCP
		126	object, a txn object, the type of the transaction and the attributes. Use
		127	it like this:
		128
		129	sub progress_cb {
		130	my ($self, $txn, $type, $attr) = @_;
		131
		132	warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
		133	}
159		134
160	=cut	135	=cut
161		136
162	sub new {	137	sub new {
163	my $class = shift;	138	my $class = shift;
164	my $self = bless { @_ }, $class;	139	my $self = bless { @_ }, $class;
165		140
166	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";	141	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
167	$self->{port} \|\|= $ENV{FREDPORT} \|\| 8481;	142	$self->{port} \|\|= $ENV{FREDPORT} \|\| 8481;
168		143
169	#$self->{nodehello} = $self->client_hello
170	# or croak "unable to get nodehello from node\n";
171
172	$self;	144	$self;
173	}	145	}
174		146
175	sub progress {	147	sub progress {
176	my ($self, $txn, $type, $attr) = @_;	148	my ($self, $txn, $type, $attr) = @_;
177	warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
178	}
179		149
		150	$self->{progress}->($self, $txn, $type, $attr)
		151	if $self->{progress};
		152	}
		153
180	=item $txn = $fcp->txn(type => attr => val,...)	154	=item $txn = $fcp->txn (type => attr => val,...)
181		155
182	The low-level interface to transactions. Don't use it.	156	The low-level interface to transactions. Don't use it unless you have
183		157	"special needs". Instead, use predefiend transactions like this:
184	Here are some examples of using transactions:
185		158
186	The blocking case, no (visible) transactions involved:	159	The blocking case, no (visible) transactions involved:
187		160
188	my $nodehello = $fcp->client_hello;	161	my $nodehello = $fcp->client_hello;
189		162
…		…
208	sub txn {	181	sub txn {
209	my ($self, $type, %attr) = @_;	182	my ($self, $type, %attr) = @_;
210		183
211	$type = touc $type;	184	$type = touc $type;
212		185
213	my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);	186	my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);
214		187
215	$txn;	188	$txn;
216	}	189	}
217		190
218	sub _txn($&) {	191	{ # transactions
		192
		193	my $txn = sub {
219	my ($name, $sub) = @_;	194	my ($name, $sub) = @_;
220	*{"$name\_txn"} = $sub;	195	*{"txn_$name"} = $sub;
221	*{$name} = sub { $sub->(@_)->result };	196	*{$name} = sub { $sub->(@_)->result };
222	}	197	};
223		198
224	=item $txn = $fcp->txn_client_hello	199	=item $txn = $fcp->txn_client_hello
225		200
226	=item $nodehello = $fcp->client_hello	201	=item $nodehello = $fcp->client_hello
227		202
…		…
233	protocol => "1.2",	208	protocol => "1.2",
234	}	209	}
235		210
236	=cut	211	=cut
237		212
238	_txn client_hello => sub {	213	$txn->(client_hello => sub {
239	my ($self) = @_;	214	my ($self) = @_;
240		215
241	$self->txn ("client_hello");	216	$self->txn ("client_hello");
242	};	217	});
243		218
244	=item $txn = $fcp->txn_client_info	219	=item $txn = $fcp->txn_client_info
245		220
246	=item $nodeinfo = $fcp->client_info	221	=item $nodeinfo = $fcp->client_info
247		222
…		…
271	routing_time => "a5",	246	routing_time => "a5",
272	}	247	}
273		248
274	=cut	249	=cut
275		250
276	_txn client_info => sub {	251	$txn->(client_info => sub {
277	my ($self) = @_;	252	my ($self) = @_;
278		253
279	$self->txn ("client_info");	254	$self->txn ("client_info");
280	};	255	});
281		256
282	=item $txn = $fcp->txn_generate_chk ($metadata, $data)	257	=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
283		258
284	=item $uri = $fcp->generate_chk ($metadata, $data)	259	=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
285		260
286	Creates a new CHK, given the metadata and data. UNTESTED.	261	Calculates a CHK, given the metadata and data. C<$cipher> is either
		262	C<Rijndael> or C<Twofish>, with the latter being the default.
287		263
288	=cut	264	=cut
289		265
290	_txn generate_chk => sub {	266	$txn->(generate_chk => sub {
291	my ($self, $metadata, $data) = @_;	267	my ($self, $metadata, $data, $cipher) = @_;
292		268
293	$self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);	269	$metadata = Net::FCP::Metadata::build_metadata $metadata;
		270
		271	$self->txn (generate_chk =>
		272	data => "$metadata$data",
		273	metadata_length => xeh length $metadata,
		274	cipher => $cipher \|\| "Twofish");
294	};	275	});
295		276
296	=item $txn = $fcp->txn_generate_svk_pair	277	=item $txn = $fcp->txn_generate_svk_pair
297		278
298	=item ($public, $private) = @{ $fcp->generate_svk_pair }	279	=item ($public, $private) = @{ $fcp->generate_svk_pair }
299		280
300	Creates a new SVK pair. Returns an arrayref.	281	Creates a new SVK pair. Returns an arrayref with the public key, the
		282	private key and a crypto key, which is just additional entropy.
301		283
302	[	284	[
303	"hKs0-WDQA4pVZyMPKNFsK1zapWY",	285	"acLx4dux9fvvABH15Gk6~d3I-yw",
304	"ZnmvMITaTXBMFGl4~jrjuyWxOWg"	286	"cPoDkDMXDGSMM32plaPZDhJDxSs",
		287	"BH7LXCov0w51-y9i~BoB3g",
305	]	288	]
306		289
307	=cut	290	A private key (for inserting) can be constructed like this:
308		291
		292	SSK@<private_key>,<crypto_key>/<name>
		293
		294	It can be used to insert data. The corresponding public key looks like this:
		295
		296	SSK@<public_key>PAgM,<crypto_key>/<name>
		297
		298	Watch out for the C<PAgM>-part!
		299
		300	=cut
		301
309	_txn generate_svk_pair => sub {	302	$txn->(generate_svk_pair => sub {
310	my ($self) = @_;	303	my ($self) = @_;
311		304
312	$self->txn ("generate_svk_pair");	305	$self->txn ("generate_svk_pair");
313	};	306	});
314		307
315	=item $txn = $fcp->txn_insert_private_key ($private)	308	=item $txn = $fcp->txn_invert_private_key ($private)
316		309
317	=item $uri = $fcp->insert_private_key ($private)	310	=item $public = $fcp->invert_private_key ($private)
318		311
319	Inserts a private key. $private can be either an insert URI (must start	312	Inverts a private key (returns the public key). C<$private> can be either
320	with freenet:SSK@) or a raw private key (i.e. the private value you get back	313	an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
321	from C<generate_svk_pair>).	314	the private value you get back from C<generate_svk_pair>).
322		315
323	Returns the public key.	316	Returns the public key.
324		317
325	UNTESTED.
326
327	=cut	318	=cut
328		319
329	_txn insert_private_key => sub {	320	$txn->(invert_private_key => sub {
330	my ($self, $privkey) = @_;	321	my ($self, $privkey) = @_;
331		322
332	$self->txn (invert_private_key => private => $privkey);	323	$self->txn (invert_private_key => private => $privkey);
333	};	324	});
334		325
335	=item $txn = $fcp->txn_get_size ($uri)	326	=item $txn = $fcp->txn_get_size ($uri)
336		327
337	=item $length = $fcp->get_size ($uri)	328	=item $length = $fcp->get_size ($uri)
338		329
339	Finds and returns the size (rounded up to the nearest power of two) of the	330	Finds and returns the size (rounded up to the nearest power of two) of the
340	given document.	331	given document.
341		332
342	UNTESTED.
343
344	=cut	333	=cut
345		334
346	_txn get_size => sub {	335	$txn->(get_size => sub {
347	my ($self, $uri) = @_;	336	my ($self, $uri) = @_;
348		337
349	$self->txn (get_size => URI => $uri);	338	$self->txn (get_size => URI => $uri);
350	};	339	});
351		340
352	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])	341	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
353		342
354	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)	343	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
355		344
356	Fetches a (small, as it should fit into memory) file from	345	Fetches a (small, as it should fit into memory) key content block from
357	freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or	346	freenet. C<$meta> is a C<Net::FCP::Metadata> object or C<undef>).
358	C<undef>).
359		347
360	Due to the overhead, a better method to download big files should be used.	348	The C<$uri> should begin with C<freenet:>, but the scheme is currently
		349	added, if missing.
361		350
362	my ($meta, $data) = @{	351	my ($meta, $data) = @{
363	$fcp->client_get (	352	$fcp->client_get (
364	"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"	353	"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
365	)	354	)
366	};	355	};
367		356
368	=cut	357	=cut
369		358
370	_txn client_get => sub {	359	$txn->(client_get => sub {
371	my ($self, $uri, $htl, $removelocal) = @_;	360	my ($self, $uri, $htl, $removelocal) = @_;
372		361
373	$self->txn (client_get => URI => $uri, hops_to_live => ($htl \|\| 15), remove_local_key => $removelocal ? "true" : "false");	362	$uri =~ s/^freenet://; $uri = "freenet:$uri";
		363
		364	$self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
		365	remove_local_key => $removelocal ? "true" : "false");
374	};	366	});
375		367
376	=item MISSING: ClientPut	368	=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
		369
		370	=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
		371
		372	Insert a new key. If the client is inserting a CHK, the URI may be
		373	abbreviated as just CHK@. In this case, the node will calculate the
		374	CHK. If the key is a private SSK key, the node will calculcate the public
		375	key and the resulting public URI.
		376
		377	C<$meta> can be a hash reference (same format as returned by
		378	C<Net::FCP::parse_metadata>) or a string.
		379
		380	The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
		381
		382	=cut
		383
		384	$txn->(client_put => sub {
		385	my ($self, $uri, $metadata, $data, $htl, $removelocal) = @_;
		386
		387	$metadata = Net::FCP::Metadata::build_metadata $metadata;
		388	$uri =~ s/^freenet://; $uri = "freenet:$uri";
		389
		390	$self->txn (client_put => URI => $uri,
		391	hops_to_live => xeh (defined $htl ? $htl : 15),
		392	remove_local_key => $removelocal ? "true" : "false",
		393	data => "$metadata$data", metadata_length => xeh length $metadata);
		394	});
		395
		396	} # transactions
377		397
378	=back	398	=back
379		399
380	=head2 THE Net::FCP::Txn CLASS	400	=head2 THE Net::FCP::Txn CLASS
381		401
382	All requests (or transactions) are executed in a asynchroneous way (LIE:	402	All requests (or transactions) are executed in a asynchronous way. For
383	uploads are blocking). For each request, a C<Net::FCP::Txn> object is	403	each request, a C<Net::FCP::Txn> object is created (worse: a tcp
384	created (worse: a tcp connection is created, too).	404	connection is created, too).
385		405
386	For each request there is actually a different subclass (and it's possible	406	For each request there is actually a different subclass (and it's possible
387	to subclass these, although of course not documented).	407	to subclass these, although of course not documented).
388		408
389	The most interesting method is C<result>.	409	The most interesting method is C<result>.
…		…
417	while (my ($k, $v) = each %{$self->{attr}}) {	437	while (my ($k, $v) = each %{$self->{attr}}) {
418	$attr .= (Net::FCP::touc $k) . "=$v\012"	438	$attr .= (Net::FCP::touc $k) . "=$v\012"
419	}	439	}
420		440
421	if (defined $data) {	441	if (defined $data) {
422	$attr .= "DataLength=" . (length $data) . "\012";	442	$attr .= sprintf "DataLength=%x\012", length $data;
423	$data = "Data\012$data";	443	$data = "Data\012$data";
424	} else {	444	} else {
425	$data = "EndMessage\012";	445	$data = "EndMessage\012";
426	}	446	}
427		447
…		…
434	and !$!{EINPROGRESS}	454	and !$!{EINPROGRESS}
435	and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";	455	and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
436		456
437	$self->{sbuf} =	457	$self->{sbuf} =
438	"\x00\x00\x00\x02"	458	"\x00\x00\x00\x02"
439	. Net::FCP::touc $self->{type}	459	. (Net::FCP::touc $self->{type})
440	. "\012$attr$data";	460	. "\012$attr$data";
441		461
442	#$fh->shutdown (1); # freenet buggy?, well, it's java...	462	#shutdown $fh, 1; # freenet buggy?, well, it's java...
443		463
444	$self->{fh} = $fh;	464	$self->{fh} = $fh;
445		465
446	$self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);	466	$self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
447		467
…		…
483		503
484	sub userdata($$) {	504	sub userdata($$) {
485	my ($self, $data) = @_;	505	my ($self, $data) = @_;
486	$self->{userdata} = $data;	506	$self->{userdata} = $data;
487	$self;	507	$self;
		508	}
		509
		510	=item $txn->cancel (%attr)
		511
		512	Cancels the operation with a C<cancel> exception anf the given attributes
		513	(consider at least giving the attribute C<reason>).
		514
		515	UNTESTED.
		516
		517	=cut
		518
		519	sub cancel {
		520	my ($self, %attr) = @_;
		521	$self->throw (Net::FCP::Exception->new (cancel => { %attr }));
		522	$self->set_result;
		523	$self->eof;
488	}	524	}
489		525
490	sub fh_ready_w {	526	sub fh_ready_w {
491	my ($self) = @_;	527	my ($self) = @_;
492		528
…		…
532	} else {	568	} else {
533	$self->eof;	569	$self->eof;
534	}	570	}
535	}	571	}
536		572
537	sub rcv_data {
538	my ($self, $chunk) = @_;
539
540	$self->{data} .= $chunk;
541
542	$self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
543	}
544
545	sub rcv {	573	sub rcv {
546	my ($self, $type, $attr) = @_;	574	my ($self, $type, $attr) = @_;
547		575
548	$type = Net::FCP::tolc $type;	576	$type = Net::FCP::tolc $type;
549		577
…		…
557	}	585	}
558		586
559	# used as a default exception thrower	587	# used as a default exception thrower
560	sub rcv_throw_exception {	588	sub rcv_throw_exception {
561	my ($self, $attr, $type) = @_;	589	my ($self, $attr, $type) = @_;
562	$self->throw (new Net::FCP::Exception $type, $attr);	590	$self->throw (Net::FCP::Exception->new ($type, $attr));
563	}	591	}
564		592
565	*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;	593	*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;
566	*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;	594	*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;
567		595
568	sub throw {	596	sub throw {
569	my ($self, $exc) = @_;	597	my ($self, $exc) = @_;
570		598
571	$self->{exception} = $exc;	599	$self->{exception} = $exc;
572	$self->set_result (1);	600	$self->set_result;
573	$self->eof; # must be last to avoid loops	601	$self->eof; # must be last to avoid loops
574	}	602	}
575		603
576	sub set_result {	604	sub set_result {
577	my ($self, $result) = @_;	605	my ($self, $result) = @_;
…		…
589	delete $self->{w};	617	delete $self->{w};
590	delete $self->{fh};	618	delete $self->{fh};
591		619
592	delete $self->{fcp}{txn}{$self};	620	delete $self->{fcp}{txn}{$self};
593		621
594	$self->set_result; # just in case	622	unless (exists $self->{result}) {
		623	$self->throw (Net::FCP::Exception->new (short_data => {
		624	reason => "unexpected eof or internal node error",
		625	}));
		626	}
595	}	627	}
596		628
597	sub progress {	629	sub progress {
598	my ($self, $type, $attr) = @_;	630	my ($self, $type, $attr) = @_;
		631
599	$self->{fcp}->progress ($self, $type, $attr);	632	$self->{fcp}->progress ($self, $type, $attr);
600	}	633	}
601		634
602	=item $result = $txn->result	635	=item $result = $txn->result
603		636
604	Waits until a result is available and then returns it.	637	Waits until a result is available and then returns it.
605		638
606	This waiting is (depending on your event model) not very efficient, as it	639	This waiting is (depending on your event model) not very efficient, as it
607	is done outside the "mainloop".	640	is done outside the "mainloop". The biggest problem, however, is that it's
		641	blocking one thread of execution. Try to use the callback mechanism, if
		642	possible, and call result from within the callback (or after is has been
		643	run), as then no waiting is necessary.
608		644
609	=cut	645	=cut
610		646
611	sub result {	647	sub result {
612	my ($self) = @_;	648	my ($self) = @_;
…		…
643	use base Net::FCP::Txn;	679	use base Net::FCP::Txn;
644		680
645	sub rcv_success {	681	sub rcv_success {
646	my ($self, $attr) = @_;	682	my ($self, $attr) = @_;
647		683
648	$self->set_result ($attr);	684	$self->set_result ($attr->{uri});
649	}	685	}
650		686
651	package Net::FCP::Txn::GenerateSVKPair;	687	package Net::FCP::Txn::GenerateSVKPair;
652		688
653	use base Net::FCP::Txn;	689	use base Net::FCP::Txn;
654		690
655	sub rcv_success {	691	sub rcv_success {
656	my ($self, $attr) = @_;	692	my ($self, $attr) = @_;
657
658	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);	693	$self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
659	}	694	}
660		695
661	package Net::FCP::Txn::InvertPrivateKey;	696	package Net::FCP::Txn::InvertPrivateKey;
662		697
663	use base Net::FCP::Txn;	698	use base Net::FCP::Txn;
664		699
665	sub rcv_success {	700	sub rcv_success {
666	my ($self, $attr) = @_;	701	my ($self, $attr) = @_;
667
668	$self->set_result ($attr->{PublicKey});	702	$self->set_result ($attr->{public_key});
669	}	703	}
670		704
671	package Net::FCP::Txn::GetSize;	705	package Net::FCP::Txn::GetSize;
672		706
673	use base Net::FCP::Txn;	707	use base Net::FCP::Txn;
674		708
675	sub rcv_success {	709	sub rcv_success {
676	my ($self, $attr) = @_;	710	my ($self, $attr) = @_;
677
678	$self->set_result ($attr->{Length});	711	$self->set_result (hex $attr->{length});
679	}	712	}
680		713
681	package Net::FCP::Txn::GetPut;	714	package Net::FCP::Txn::GetPut;
682		715
683	# base class for get and put	716	# base class for get and put
684		717
685	use base Net::FCP::Txn;	718	use base Net::FCP::Txn;
686		719
687	*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;	720	*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
688	*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;	721	*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
689		722
690	sub rcv_restarted {	723	sub rcv_restarted {
691	my ($self, $attr, $type) = @_;	724	my ($self, $attr, $type) = @_;
692		725
693	delete $self->{datalength};	726	delete $self->{datalength};
…		…
701		734
702	use base Net::FCP::Txn::GetPut;	735	use base Net::FCP::Txn::GetPut;
703		736
704	*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;	737	*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;
705		738
		739	sub rcv_data {
		740	my ($self, $chunk) = @_;
		741
		742	$self->{data} .= $chunk;
		743
		744	$self->progress ("data", { chunk => length $chunk, received => length $self->{data}, total => $self->{datalength} });
		745
		746	if ($self->{datalength} == length $self->{data}) {
		747	my $data = delete $self->{data};
		748	my $meta = new Net::FCP::Metadata (substr $data, 0, $self->{metalength}, "");
		749
		750	$self->set_result ([$meta, $data]);
		751	$self->eof;
		752	}
		753	}
		754
706	sub rcv_data_found {	755	sub rcv_data_found {
707	my ($self, $attr, $type) = @_;	756	my ($self, $attr, $type) = @_;
708		757
709	$self->progress ($type, $attr);	758	$self->progress ($type, $attr);
710		759
711	$self->{datalength} = hex $attr->{data_length};	760	$self->{datalength} = hex $attr->{data_length};
712	$self->{metalength} = hex $attr->{metadata_length};	761	$self->{metalength} = hex $attr->{metadata_length};
713	}	762	}
714		763
715	sub eof {
716	my ($self) = @_;
717
718	if ($self->{datalength} == length $self->{data}) {
719	my $data = delete $self->{data};
720	my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
721
722	$self->set_result ([$meta, $data]);
723	} elsif (!exists $self->{result}) {
724	$self->throw (Net::FCP::Exception->new (short_data => {
725	reason => "unexpected eof or internal node error",
726	received => length $self->{data},
727	expected => $self->{datalength},
728	}));
729	}
730	}
731
732	package Net::FCP::Txn::ClientPut;	764	package Net::FCP::Txn::ClientPut;
733		765
734	use base Net::FCP::Txn::GetPut;	766	use base Net::FCP::Txn::GetPut;
735		767
736	*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;	768	*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
737	*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
738		769
739	sub rcv_pending {	770	sub rcv_pending {
740	my ($self, $attr, $type) = @_;	771	my ($self, $attr, $type) = @_;
741	$self->progress ($type, $attr);	772	$self->progress ($type, $attr);
742	}	773	}
…		…
744	sub rcv_success {	775	sub rcv_success {
745	my ($self, $attr, $type) = @_;	776	my ($self, $attr, $type) = @_;
746	$self->set_result ($attr);	777	$self->set_result ($attr);
747	}	778	}
748		779
		780	sub rcv_key_collision {
		781	my ($self, $attr, $type) = @_;
		782	$self->set_result ({ key_collision => 1, %$attr });
		783	}
		784
		785	=back
		786
		787	=head2 The Net::FCP::Exception CLASS
		788
		789	Any unexpected (non-standard) responses that make it impossible to return
		790	the advertised result will result in an exception being thrown when the
		791	C<result> method is called.
		792
		793	These exceptions are represented by objects of this class.
		794
		795	=over 4
		796
		797	=cut
		798
749	package Net::FCP::Exception;	799	package Net::FCP::Exception;
750		800
751	use overload	801	use overload
752	'""' => sub {	802	'""' => sub {
753	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";	803	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
754	};	804	};
		805
		806	=item $exc = new Net::FCP::Exception $type, \%attr
		807
		808	Create a new exception object of the given type (a string like
		809	C<route_not_found>), and a hashref containing additional attributes
		810	(usually the attributes of the message causing the exception).
		811
		812	=cut
755		813
756	sub new {	814	sub new {
757	my ($class, $type, $attr) = @_;	815	my ($class, $type, $attr) = @_;
758		816
759	bless [Net::FCP::tolc $type, { %$attr }], $class;	817	bless [Net::FCP::tolc $type, { %$attr }], $class;
760	}	818	}
761		819
		820	=item $exc->type([$type])
		821
		822	With no arguments, returns the exception type. Otherwise a boolean
		823	indicating wether the exception is of the given type is returned.
		824
		825	=cut
		826
		827	sub type {
		828	my ($self, $type) = @_;
		829
		830	@_ >= 2
		831	? $self->[0] eq $type
		832	: $self->[0];
		833	}
		834
		835	=item $exc->attr([$attr])
		836
		837	With no arguments, returns the attributes. Otherwise the named attribute
		838	value is returned.
		839
		840	=cut
		841
		842	sub attr {
		843	my ($self, $attr) = @_;
		844
		845	@_ >= 2
		846	? $self->[1]{$attr}
		847	: $self->[1];
		848	}
		849
762	=back	850	=back
763		851
764	=head1 SEE ALSO	852	=head1 SEE ALSO
765		853
766	L<http://freenet.sf.net>.	854	L<http://freenet.sf.net>.
…		…
772	Marc Lehmann <pcg@goof.com>	860	Marc Lehmann <pcg@goof.com>
773	http://www.goof.com/pcg/marc/	861	http://www.goof.com/pcg/marc/
774		862
775	=cut	863	=cut
776		864
		865	package Net::FCP::Event::Auto;
		866
		867	my @models = (
		868	[Coro => Coro::Event::],
		869	[Event => Event::],
		870	[Glib => Glib::],
		871	[Tk => Tk::],
		872	);
		873
		874	sub AUTOLOAD {
		875	$AUTOLOAD =~ s/.*://;
		876
		877	for (@models) {
		878	my ($model, $package) = @$_;
		879	if (defined ${"$package\::VERSION"}) {
		880	$EVENT = "Net::FCP::Event::$model";
		881	eval "require $EVENT"; die if $@;
		882	goto &{"$EVENT\::$AUTOLOAD"};
		883	}
		884	}
		885
		886	for (@models) {
		887	my ($model, $package) = @$_;
		888	$EVENT = "Net::FCP::Event::$model";
		889	if (eval "require $EVENT") {
		890	goto &{"$EVENT\::$AUTOLOAD"};
		891	}
		892	}
		893
		894	die "No event module selected for Net::FCP and autodetect failed. Install any of these: Coro, Event, Glib or Tk.";
		895	}
		896
777	1;	897	1;
778		898

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Net-FCP/FCP.pm (file contents): Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC vs. Revision 1.30 by root, Fri May 14 16:12:26 2004 UTC

Diff Legend

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC vs.
Revision 1.30 by root, Fri May 14 16:12:26 2004 UTC