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

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.2 by root, Sun Sep 7 23:20:20 2003 UTC vs.
Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC

…		…
17	of what the messages do. I am too lazy to document all this here.	17	of what the messages do. I am too lazy to document all this here.
18		18
19	=head1 WARNING	19	=head1 WARNING
20		20
21	This module is alpha. While it probably won't destroy (much :) of your	21	This module is alpha. While it probably won't destroy (much :) of your
22	data, it currently works only with the Event module (alkthough the event	22	data, it currently falls short of what it should provide (intelligent uri
23	mechanism is fully pluggable).	23	following, splitfile downloads, healing...)
		24
		25	=head2 IMPORT TAGS
		26
		27	Nothing much can be "imported" from this module right now. There are,
		28	however, certain "import tags" that can be used to select the event model
		29	to be used.
		30
		31	Event models are implemented as modules under the C<Net::FCP::Event::xyz>
		32	class, where C<xyz> is the event model to use. The default is C<Event> (or
		33	later C<Auto>).
		34
		35	The import tag to use is named C<event=xyz>, e.g. C<event=Event>,
		36	C<event=Glib> etc.
		37
		38	You should specify the event module to use only in the main program.
24		39
25	=head2 THE Net::FCP CLASS	40	=head2 THE Net::FCP CLASS
26		41
27	=over 4	42	=over 4
28		43
29	=cut	44	=cut
30		45
31	package Net::FCP;	46	package Net::FCP;
32		47
33	use Carp;	48	use Carp;
34	use IO::Socket::INET;
35		49
36	$VERSION = 0.01;	50	$VERSION = 0.05;
37		51
38	sub event_reg_cb {	52	no warnings;
39	my ($obj) = @_;
40	require Event;
41		53
42	$obj->{eventdata} = Event->io (	54	our $EVENT = Net::FCP::Event::Auto::;
43	fd => $obj->{fh},	55	$EVENT = Net::FCP::Event::Event;#d#
44	poll => 'r',	56
45	cb => sub {	57	sub import {
46	$obj->fh_ready;	58	shift;
		59
		60	for (@_) {
		61	if (/^event=(\w+)$/) {
		62	$EVENT = "Net::FCP::Event::$1";
47	},	63	}
48	);	64	}
		65	eval "require $EVENT";
		66	die $@ if $@;
49	}	67	}
50
51	sub event_unreg_cb {
52	$_[0]{eventdata}
53	and (delete $_[0]{eventdata})->cancel;
54	}
55
56	sub event_wait_cb {
57	Event::one_event();
58	}
59
60	$regcb = \&event_reg_cb;
61	$unregcb = \&event_unreg_cb;
62	$waitcb = \&event_wait_cb;
63		68
64	sub touc($) {	69	sub touc($) {
65	local $_ = shift;	70	local $_ = shift;
66	1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;	71	1 while s/((?:^\|_)(?:svk\|chk\|uri)(?:_\|$))/\U$1/;
67	s/(?:^\|_)(.)/\U$1/g;	72	s/(?:^\|_)(.)/\U$1/g;
…		…
72	local $_ = shift;	77	local $_ = shift;
73	s/(?<=[a-z])(?=[A-Z])/_/g;	78	s/(?<=[a-z])(?=[A-Z])/_/g;
74	lc $_;	79	lc $_;
75	}	80	}
76		81
		82	=item $meta = Net::FCP::parse_metadata $string
		83
		84	Parse a metadata string and return it.
		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	}
		150
77	=item $fcp = new Net::FCP [host => $host][, port => $port]	151	=item $fcp = new Net::FCP [host => $host][, port => $port]
78		152
79	Create a new virtual FCP connection to the given host and port (default	153	Create a new virtual FCP connection to the given host and port (default
80	127.0.0.1:8481).	154	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
81		155
82	Connections are virtual because no persistent physical connection is	156	Connections are virtual because no persistent physical connection is
83	established. However, the existance of the node is checked by executing a	157	established. However, the existance of the node is checked by executing a
84	C<ClientHello> transaction.	158	C<ClientHello> transaction.
85		159
…		…
87		161
88	sub new {	162	sub new {
89	my $class = shift;	163	my $class = shift;
90	my $self = bless { @_ }, $class;	164	my $self = bless { @_ }, $class;
91		165
92	$self->{host} \|\|= "127.0.0.1";	166	$self->{host} \|\|= $ENV{FREDHOST} \|\| "127.0.0.1";
93	$self->{port} \|\|= 8481;	167	$self->{port} \|\|= $ENV{FREDPORT} \|\| 8481;
94		168
95	$self->{nodehello} = $self->txn("ClientHello")->result	169	#$self->{nodehello} = $self->client_hello
96	or croak "unable to get nodehello from node\n";	170	# or croak "unable to get nodehello from node\n";
97		171
98	$self;	172	$self;
99	}	173	}
100		174
		175	sub progress {
		176	my ($self, $txn, $type, $attr) = @_;
		177	warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
		178	}
		179
101	=item $txn = $fcp->txn(type => attr => val,...)	180	=item $txn = $fcp->txn(type => attr => val,...)
102		181
103	The low-level interface to transactions. Don't use it.	182	The low-level interface to transactions. Don't use it.
		183
		184	Here are some examples of using transactions:
		185
		186	The blocking case, no (visible) transactions involved:
		187
		188	my $nodehello = $fcp->client_hello;
		189
		190	A transaction used in a blocking fashion:
		191
		192	my $txn = $fcp->txn_client_hello;
		193	...
		194	my $nodehello = $txn->result;
		195
		196	Or shorter:
		197
		198	my $nodehello = $fcp->txn_client_hello->result;
		199
		200	Setting callbacks:
		201
		202	$fcp->txn_client_hello->cb(
		203	sub { my $nodehello => $_[0]->result }
		204	);
104		205
105	=cut	206	=cut
106		207
107	sub txn {	208	sub txn {
108	my ($self, $type, %attr) = @_;	209	my ($self, $type, %attr) = @_;
…		…
126		227
127	Executes a ClientHello request and returns it's results.	228	Executes a ClientHello request and returns it's results.
128		229
129	{	230	{
130	max_file_size => "5f5e100",	231	max_file_size => "5f5e100",
		232	node => "Fred,0.6,1.46,7050"
131	protocol => "1.2",	233	protocol => "1.2",
132	node => "Fred,0.6,1.46,7050"
133	}	234	}
134		235
135	=cut	236	=cut
136		237
137	_txn client_hello => sub {	238	_txn client_hello => sub {
…		…
145	=item $nodeinfo = $fcp->client_info	246	=item $nodeinfo = $fcp->client_info
146		247
147	Executes a ClientInfo request and returns it's results.	248	Executes a ClientInfo request and returns it's results.
148		249
149	{	250	{
150	max_file_size => "5f5e100",
151	datastore_max => "2540be400",
152	node_port => 369,
153	java_name => "Java HotSpot(_T_M) Server VM",
154	operating_system_version => "2.4.20",
155	estimated_load => 52,
156	free_memory => "5cc0148",
157	datastore_free => "5ce03400",
158	node_address => "1.2.3.4",
159	active_jobs => "1f",	251	active_jobs => "1f",
160	allocated_memory => "bde0000",	252	allocated_memory => "bde0000",
161	architecture => "i386",	253	architecture => "i386",
		254	available_threads => 17,
		255	datastore_free => "5ce03400",
		256	datastore_max => "2540be400",
		257	datastore_used => "1f72bb000",
		258	estimated_load => 52,
		259	free_memory => "5cc0148",
		260	is_transient => "false",
		261	java_name => "Java HotSpot(_T_M) Server VM",
		262	java_vendor => "http://www.blackdown.org/",
		263	java_version => "Blackdown-1.4.1-01",
		264	least_recent_timestamp => "f41538b878",
		265	max_file_size => "5f5e100",
		266	most_recent_timestamp => "f77e2cc520"
		267	node_address => "1.2.3.4",
		268	node_port => 369,
		269	operating_system => "Linux",
		270	operating_system_version => "2.4.20",
162	routing_time => "a5",	271	routing_time => "a5",
163	least_recent_timestamp => "f41538b878",
164	available_threads => 17,
165	datastore_used => "1f72bb000",
166	java_version => "Blackdown-1.4.1-01",
167	is_transient => "false",
168	operating_system => "Linux",
169	java_vendor => "http://www.blackdown.org/",
170	most_recent_timestamp => "f77e2cc520"
171	}	272	}
172		273
173	=cut	274	=cut
174		275
175	_txn client_info => sub {	276	_txn client_info => sub {
…		…
187	=cut	288	=cut
188		289
189	_txn generate_chk => sub {	290	_txn generate_chk => sub {
190	my ($self, $metadata, $data) = @_;	291	my ($self, $metadata, $data) = @_;
191		292
192	$self->txn (generate_chk => data => "$data$metadata", meta_data_length => length $metadata);	293	$self->txn (generate_chk => data => "$data$metadata", metadata_length => length $metadata);
193	};	294	};
194		295
195	=item $txn = $fcp->txn_generate_svk_pair	296	=item $txn = $fcp->txn_generate_svk_pair
196		297
197	=item ($public, $private) = @{ $fcp->generate_svk_pair }	298	=item ($public, $private) = @{ $fcp->generate_svk_pair }
…		…
246	my ($self, $uri) = @_;	347	my ($self, $uri) = @_;
247		348
248	$self->txn (get_size => URI => $uri);	349	$self->txn (get_size => URI => $uri);
249	};	350	};
250		351
		352	=item $txn = $fcp->txn_client_get ($uri [, $htl = 15 [, $removelocal = 0]])
		353
		354	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
		355
		356	Fetches a (small, as it should fit into memory) file from
		357	freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
		358	C<undef>).
		359
		360	Due to the overhead, a better method to download big files should be used.
		361
		362	my ($meta, $data) = @{
		363	$fcp->client_get (
		364	"freenet:CHK@hdXaxkwZ9rA8-SidT0AN-bniQlgPAwI,XdCDmBuGsd-ulqbLnZ8v~w"
		365	)
		366	};
		367
		368	=cut
		369
		370	_txn client_get => sub {
		371	my ($self, $uri, $htl, $removelocal) = @_;
		372
		373	$self->txn (client_get => URI => $uri, hops_to_live => ($htl \|\| 15), remove_local_key => $removelocal ? "true" : "false");
		374	};
		375
251	=item MISSING: ClientGet, ClientPut	376	=item MISSING: ClientPut
252		377
253	=back	378	=back
254		379
255	=head2 THE Net::FCP::Txn CLASS	380	=head2 THE Net::FCP::Txn CLASS
256		381
…		…
267		392
268	=cut	393	=cut
269		394
270	package Net::FCP::Txn;	395	package Net::FCP::Txn;
271		396
		397	use Fcntl;
		398	use Socket;
		399
272	=item new arg => val,...	400	=item new arg => val,...
273		401
274	Creates a new C<Net::FCP::Txn> object. Not normally used.	402	Creates a new C<Net::FCP::Txn> object. Not normally used.
275		403
276	=cut	404	=cut
277		405
278	sub new {	406	sub new {
279	my $class = shift;	407	my $class = shift;
280	my $self = bless { @_ }, $class;	408	my $self = bless { @_ }, $class;
		409
		410	$self->{signal} = $EVENT->new_signal;
		411
		412	$self->{fcp}{txn}{$self} = $self;
281		413
282	my $attr = "";	414	my $attr = "";
283	my $data = delete $self->{attr}{data};	415	my $data = delete $self->{attr}{data};
284		416
285	while (my ($k, $v) = each %{$self->{attr}}) {	417	while (my ($k, $v) = each %{$self->{attr}}) {
…		…
291	$data = "Data\012$data";	423	$data = "Data\012$data";
292	} else {	424	} else {
293	$data = "EndMessage\012";	425	$data = "EndMessage\012";
294	}	426	}
295		427
296	my $fh = new IO::Socket::INET	428	socket my $fh, PF_INET, SOCK_STREAM, 0
297	PeerHost => $self->{fcp}{host},	429	or Carp::croak "unable to create new tcp socket: $!";
298	PeerPort => $self->{fcp}{port}
299	or Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
300
301	binmode $fh, ":raw";	430	binmode $fh, ":raw";
		431	fcntl $fh, F_SETFL, O_NONBLOCK;
		432	connect $fh, (sockaddr_in $self->{fcp}{port}, inet_aton $self->{fcp}{host})
		433	and !$!{EWOULDBLOCK}
		434	and !$!{EINPROGRESS}
		435	and Carp::croak "FCP::txn: unable to connect to $self->{fcp}{host}:$self->{fcp}{port}: $!\n";
302		436
303	if (0) {	437	$self->{sbuf} =
304	print	438	"\x00\x00\x00\x02"
305	Net::FCP::touc $self->{type}, "\012",
306	$attr,
307	$data, "\012";
308	}
309
310	print $fh
311	"\x00\x00", "\x00\x02", # SESSID, PRESID
312	Net::FCP::touc $self->{type}, "\012",	439	. Net::FCP::touc $self->{type}
313	$attr,	440	. "\012$attr$data";
314	$data;
315		441
316	#$fh->shutdown (1); # freenet buggy?, well, it's java...	442	#$fh->shutdown (1); # freenet buggy?, well, it's java...
317		443
318	$self->{fh} = $fh;	444	$self->{fh} = $fh;
319		445
320	$Net::FCP::regcb->($self);	446	$self->{w} = $EVENT->new_from_fh ($fh)->cb(sub { $self->fh_ready_w })->poll(0, 1, 1);
321		447
322	$self;	448	$self;
323	}	449	}
324		450
		451	=item $txn = $txn->cb ($coderef)
		452
		453	Sets a callback to be called when the request is finished. The coderef
		454	will be called with the txn as it's sole argument, so it has to call
		455	C<result> itself.
		456
		457	Returns the txn object, useful for chaining.
		458
		459	Example:
		460
		461	$fcp->txn_client_get ("freenet:CHK....")
		462	->userdata ("ehrm")
		463	->cb(sub {
		464	my $data = shift->result;
		465	});
		466
		467	=cut
		468
		469	sub cb($$) {
		470	my ($self, $cb) = @_;
		471	$self->{cb} = $cb;
		472	$self;
		473	}
		474
		475	=item $txn = $txn->userdata ([$userdata])
		476
		477	Set user-specific data. This is useful in progress callbacks. The data can be accessed
		478	using C<< $txn->{userdata} >>.
		479
		480	Returns the txn object, useful for chaining.
		481
		482	=cut
		483
		484	sub userdata($$) {
		485	my ($self, $data) = @_;
		486	$self->{userdata} = $data;
		487	$self;
		488	}
		489
325	sub fh_ready {	490	sub fh_ready_w {
		491	my ($self) = @_;
		492
		493	my $len = syswrite $self->{fh}, $self->{sbuf};
		494
		495	if ($len > 0) {
		496	substr $self->{sbuf}, 0, $len, "";
		497	unless (length $self->{sbuf}) {
		498	fcntl $self->{fh}, F_SETFL, 0;
		499	$self->{w}->cb(sub { $self->fh_ready_r })->poll (1, 0, 1);
		500	}
		501	} elsif (defined $len) {
		502	$self->throw (Net::FCP::Exception->new (network_error => { reason => "unexpected end of file while writing" }));
		503	} else {
		504	$self->throw (Net::FCP::Exception->new (network_error => { reason => "$!" }));
		505	}
		506	}
		507
		508	sub fh_ready_r {
326	my ($self) = @_;	509	my ($self) = @_;
327		510
328	if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {	511	if (sysread $self->{fh}, $self->{buf}, 65536, length $self->{buf}) {
329	for (;;) {	512	for (;;) {
330	if ($self->{datalen}) {	513	if ($self->{datalen}) {
		514	#warn "expecting new datachunk $self->{datalen}, got ".(length $self->{buf})."\n";#d#
331	if (length $self->{buf} >= $self->{datalen}) {	515	if (length $self->{buf} >= $self->{datalen}) {
332	$self->recv_data (substr $self->{buf}, 0, $self->{datalen}, "");	516	$self->rcv_data (substr $self->{buf}, 0, delete $self->{datalen}, "");
333	} else {	517	} else {
334	last;	518	last;
335	}	519	}
336	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=(\d+)\015?\012Data\015?\012//) {	520	} elsif ($self->{buf} =~ s/^DataChunk\015?\012Length=([0-9a-fA-F]+)\015?\012Data\015?\012//) {
337	$self->{datalen} = $1;	521	$self->{datalen} = hex $1;
		522	#warn "expecting new datachunk $self->{datalen}\n";#d#
338	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(.*?)\015?\012EndMessage\015?\012//s) {	523	} elsif ($self->{buf} =~ s/^([a-zA-Z]+)\015?\012(?:(.+?)\015?\012)?EndMessage\015?\012//s) {
339	$self->rcv ($1, {	524	$self->rcv ($1, {
340	map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }	525	map { my ($a, $b) = split /=/, $_, 2; ((Net::FCP::tolc $a), $b) }
341	split /\015?\012/, $2	526	split /\015?\012/, $2
342	});	527	});
343	} else {	528	} else {
344	last;	529	last;
345	}	530	}
346	}	531	}
347	} else {	532	} else {
348	$Net::FCP::unregcb->($self);
349	delete $self->{fh};
350	$self->eof;	533	$self->eof;
351	}	534	}
352	}	535	}
353		536
354	sub rcv_data {	537	sub rcv_data {
355	my ($self, $chunk) = @_;	538	my ($self, $chunk) = @_;
		539
		540	$self->{data} .= $chunk;
		541
		542	$self->progress ("data", { chunk => length $chunk, total => length $self->{data}, end => $self->{datalength} });
356	}	543	}
357		544
358	sub rcv {	545	sub rcv {
359	my ($self, $type, $attr) = @_;	546	my ($self, $type, $attr) = @_;
360		547
361	$type = Net::FCP::tolc $type;	548	$type = Net::FCP::tolc $type;
		549
		550	#use PApp::Util; warn PApp::Util::dumpval [$type, $attr];
362		551
363	if (my $method = $self->can("rcv_$type")) {	552	if (my $method = $self->can("rcv_$type")) {
364	$method->($self, $attr, $type);	553	$method->($self, $attr, $type);
365	} else {	554	} else {
366	warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";	555	warn "received unexpected reply type '$type' for '$self->{type}', ignoring\n";
367	$self->eof;	556	}
		557	}
		558
		559	# used as a default exception thrower
		560	sub rcv_throw_exception {
		561	my ($self, $attr, $type) = @_;
		562	$self->throw (new Net::FCP::Exception $type, $attr);
		563	}
		564
		565	*rcv_failed = \&Net::FCP::Txn::rcv_throw_exception;
		566	*rcv_format_error = \&Net::FCP::Txn::rcv_throw_exception;
		567
		568	sub throw {
		569	my ($self, $exc) = @_;
		570
		571	$self->{exception} = $exc;
		572	$self->set_result (1);
		573	$self->eof; # must be last to avoid loops
		574	}
		575
		576	sub set_result {
		577	my ($self, $result) = @_;
		578
		579	unless (exists $self->{result}) {
		580	$self->{result} = $result;
		581	$self->{cb}->($self) if exists $self->{cb};
		582	$self->{signal}->send;
368	}	583	}
369	}	584	}
370		585
371	sub eof {	586	sub eof {
372	my ($self, $result) = @_;	587	my ($self) = @_;
373		588
374	$self->{result} = $result unless exists $self->{result};	589	delete $self->{w};
		590	delete $self->{fh};
		591
		592	delete $self->{fcp}{txn}{$self};
		593
		594	$self->set_result; # just in case
		595	}
		596
		597	sub progress {
		598	my ($self, $type, $attr) = @_;
		599	$self->{fcp}->progress ($self, $type, $attr);
375	}	600	}
376		601
377	=item $result = $txn->result	602	=item $result = $txn->result
378		603
379	Waits until a result is available and then returns it.	604	Waits until a result is available and then returns it.
380		605
381	This waiting is (depending on your event modul) not very efficient, as it	606	This waiting is (depending on your event model) not very efficient, as it
382	is done outside the "mainloop".	607	is done outside the "mainloop".
383		608
384	=cut	609	=cut
385		610
386	sub result {	611	sub result {
387	my ($self) = @_;	612	my ($self) = @_;
388		613
389	$Net::FCP::waitcb->() while !exists $self->{result};	614	$self->{signal}->wait while !exists $self->{result};
		615
		616	die $self->{exception} if $self->{exception};
390		617
391	return $self->{result};	618	return $self->{result};
392	}
393
394	sub DESTROY {
395	$Net::FCP::unregcb->($_[0]);
396	}	619	}
397		620
398	package Net::FCP::Txn::ClientHello;	621	package Net::FCP::Txn::ClientHello;
399		622
400	use base Net::FCP::Txn;	623	use base Net::FCP::Txn;
401		624
402	sub rcv_node_hello {	625	sub rcv_node_hello {
403	my ($self, $attr) = @_;	626	my ($self, $attr) = @_;
404		627
405	$self->eof ($attr);	628	$self->set_result ($attr);
406	}	629	}
407		630
408	package Net::FCP::Txn::ClientInfo;	631	package Net::FCP::Txn::ClientInfo;
409		632
410	use base Net::FCP::Txn;	633	use base Net::FCP::Txn;
411		634
412	sub rcv_node_info {	635	sub rcv_node_info {
413	my ($self, $attr) = @_;	636	my ($self, $attr) = @_;
414		637
415	$self->eof ($attr);	638	$self->set_result ($attr);
416	}	639	}
417		640
418	package Net::FCP::Txn::GenerateCHK;	641	package Net::FCP::Txn::GenerateCHK;
419		642
420	use base Net::FCP::Txn;	643	use base Net::FCP::Txn;
421		644
422	sub rcv_success {	645	sub rcv_success {
423	my ($self, $attr) = @_;	646	my ($self, $attr) = @_;
424		647
425	$self->eof ($attr);	648	$self->set_result ($attr);
426	}	649	}
427		650
428	package Net::FCP::Txn::GenerateSVKPair;	651	package Net::FCP::Txn::GenerateSVKPair;
429		652
430	use base Net::FCP::Txn;	653	use base Net::FCP::Txn;
431		654
432	sub rcv_success {	655	sub rcv_success {
433	my ($self, $attr) = @_;	656	my ($self, $attr) = @_;
434		657
435	$self->eof ([$attr->{PublicKey}, $attr->{PrivateKey}]);	658	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);
436	}	659	}
437		660
438	package Net::FCP::Txn::InvertPrivateKey;	661	package Net::FCP::Txn::InvertPrivateKey;
439		662
440	use base Net::FCP::Txn;	663	use base Net::FCP::Txn;
441		664
442	sub rcv_success {	665	sub rcv_success {
443	my ($self, $attr) = @_;	666	my ($self, $attr) = @_;
444		667
445	$self->eof ($attr->{PublicKey});	668	$self->set_result ($attr->{PublicKey});
446	}	669	}
447		670
448	package Net::FCP::Txn::GetSize;	671	package Net::FCP::Txn::GetSize;
449		672
450	use base Net::FCP::Txn;	673	use base Net::FCP::Txn;
451		674
452	sub rcv_success {	675	sub rcv_success {
453	my ($self, $attr) = @_;	676	my ($self, $attr) = @_;
454		677
455	$self->eof ($attr->{Length});	678	$self->set_result ($attr->{Length});
		679	}
		680
		681	package Net::FCP::Txn::GetPut;
		682
		683	# base class for get and put
		684
		685	use base Net::FCP::Txn;
		686
		687	*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
		688	*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
		689
		690	sub rcv_restarted {
		691	my ($self, $attr, $type) = @_;
		692
		693	delete $self->{datalength};
		694	delete $self->{metalength};
		695	delete $self->{data};
		696
		697	$self->progress ($type, $attr);
		698	}
		699
		700	package Net::FCP::Txn::ClientGet;
		701
		702	use base Net::FCP::Txn::GetPut;
		703
		704	*rcv_data_not_found = \&Net::FCP::Txn::rcv_throw_exception;
		705
		706	sub rcv_data_found {
		707	my ($self, $attr, $type) = @_;
		708
		709	$self->progress ($type, $attr);
		710
		711	$self->{datalength} = hex $attr->{data_length};
		712	$self->{metalength} = hex $attr->{metadata_length};
		713	}
		714
		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;
		733
		734	use base Net::FCP::Txn::GetPut;
		735
		736	*rcv_size_error = \&Net::FCP::Txn::rcv_throw_exception;
		737	*rcv_key_collision = \&Net::FCP::Txn::rcv_throw_exception;
		738
		739	sub rcv_pending {
		740	my ($self, $attr, $type) = @_;
		741	$self->progress ($type, $attr);
		742	}
		743
		744	sub rcv_success {
		745	my ($self, $attr, $type) = @_;
		746	$self->set_result ($attr);
		747	}
		748
		749	package Net::FCP::Exception;
		750
		751	use overload
		752	'""' => sub {
		753	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";
		754	};
		755
		756	sub new {
		757	my ($class, $type, $attr) = @_;
		758
		759	bless [Net::FCP::tolc $type, { %$attr }], $class;
456	}	760	}
457		761
458	=back	762	=back
459		763
460	=head1 SEE ALSO	764	=head1 SEE ALSO

Diff Legend

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

Comparing Net-FCP/FCP.pm (file contents): Revision 1.2 by root, Sun Sep 7 23:20:20 2003 UTC vs. Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC

Diff Legend

Comparing Net-FCP/FCP.pm (file contents):
Revision 1.2 by root, Sun Sep 7 23:20:20 2003 UTC vs.
Revision 1.13 by root, Wed Sep 10 05:06:16 2003 UTC