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

Comparing cvsroot/Net-FCP/FCP.pm (file contents):
Revision 1.21 by root, Tue Sep 16 07:00:59 2003 UTC vs.
Revision 1.29 by root, Thu May 13 21:43:16 2004 UTC

…		…
72		72
73	package Net::FCP;	73	package Net::FCP;
74		74
75	use Carp;	75	use Carp;
76		76
77	$VERSION = 0.08;	77	$VERSION = 0.6;
78		78
79	no warnings;	79	no warnings;
80		80
81	our $EVENT = Net::FCP::Event::Auto::;	81	our $EVENT = Net::FCP::Event::Auto::;
82		82
…		…
99	$_;	99	$_;
100	}	100	}
101		101
102	sub tolc($) {	102	sub tolc($) {
103	local $_ = shift;	103	local $_ = shift;
		104	1 while s/(SVK\|CHK\|URI)([^_])/$1\_$2/i;
		105	1 while s/([^_])(SVK\|CHK\|URI)/$1\_$2/i;
104	s/(?<=[a-z])(?=[A-Z])/_/g;	106	s/(?<=[a-z])(?=[A-Z])/_/g;
105	lc $_;	107	lc $_;
		108	}
		109
		110	# the opposite of hex
		111	sub xeh($) {
		112	sprintf "%x", $_[0];
106	}	113	}
107		114
108	=item $meta = Net::FCP::parse_metadata $string	115	=item $meta = Net::FCP::parse_metadata $string
109		116
110	Parse a metadata string and return it.	117	Parse a metadata string and return it.
…		…
175	#$meta->{tail} = substr $data, pos $data;	182	#$meta->{tail} = substr $data, pos $data;
176		183
177	$meta;	184	$meta;
178	}	185	}
179		186
		187	=item $string = Net::FCP::build_metadata $meta
		188
		189	Takes a hash reference as returned by C<Net::FCP::parse_metadata> and
		190	returns the corresponding string form. If a string is given, it's returned
		191	as is.
		192
		193	=cut
		194
		195	sub build_metadata_subhash($$$) {
		196	my ($prefix, $level, $hash) = @_;
		197
		198	join "",
		199	map
		200	ref $hash->{$_} ? build_metadata_subhash ($prefix . (Net::FCP::touc $_) . ".", $level + 1, $hash->{$_})
		201	: $prefix . ($level > 1 ? $_ : Net::FCP::touc $_) . "=" . $hash->{$_} . "\n",
		202	keys %$hash;
		203	}
		204
		205	sub build_metadata_hash($$) {
		206	my ($header, $hash) = @_;
		207
		208	if (ref $hash eq ARRAY::) {
		209	join "", map build_metadata_hash ($header, $_), @$hash
		210	} else {
		211	(Net::FCP::touc $header) . "\n"
		212	. (build_metadata_subhash "", 0, $hash)
		213	. "EndPart\n";
		214	}
		215	}
		216
		217	sub build_metadata($) {
		218	my ($meta) = @_;
		219
		220	return $meta unless ref $meta;
		221
		222	$meta = { %$meta };
		223
		224	delete $meta->{raw};
		225
		226	my $res =
		227	(build_metadata_hash version => delete $meta->{version})
		228	. (join "", map +(build_metadata_hash $_, $meta->{$_}), keys %$meta);
		229
		230	substr $res, 0, -5; # get rid of "Part". Broken Syntax....
		231	}
		232
		233
180	=item $fcp = new Net::FCP [host => $host][, port => $port]	234	=item $fcp = new Net::FCP [host => $host][, port => $port][, progress => \&cb]
181		235
182	Create a new virtual FCP connection to the given host and port (default	236	Create a new virtual FCP connection to the given host and port (default
183	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).	237	127.0.0.1:8481, or the environment variables C<FREDHOST> and C<FREDPORT>).
184		238
185	Connections are virtual because no persistent physical connection is	239	Connections are virtual because no persistent physical connection is
186	established.	240	established.
		241
		242	You can install a progress callback that is being called with the Net::FCP
		243	object, a txn object, the type of the transaction and the attributes. Use
		244	it like this:
		245
		246	sub progress_cb {
		247	my ($self, $txn, $type, $attr) = @_;
		248
		249	warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";
		250	}
187		251
188	=begin comment	252	=begin comment
189		253
190	However, the existance of the node is checked by executing a	254	However, the existance of the node is checked by executing a
191	C<ClientHello> transaction.	255	C<ClientHello> transaction.
…		…
207	$self;	271	$self;
208	}	272	}
209		273
210	sub progress {	274	sub progress {
211	my ($self, $txn, $type, $attr) = @_;	275	my ($self, $txn, $type, $attr) = @_;
212	#warn "progress<$txn,$type," . (join ":", %$attr) . ">\n";	276
		277	$self->{progress}->($self, $txn, $type, $attr)
		278	if $self->{progress};
213	}	279	}
214		280
215	=item $txn = $fcp->txn(type => attr => val,...)	281	=item $txn = $fcp->txn(type => attr => val,...)
216		282
217	The low-level interface to transactions. Don't use it.	283	The low-level interface to transactions. Don't use it.
…		…
243	sub txn {	309	sub txn {
244	my ($self, $type, %attr) = @_;	310	my ($self, $type, %attr) = @_;
245		311
246	$type = touc $type;	312	$type = touc $type;
247		313
248	my $txn = "Net::FCP::Txn::$type"->new(fcp => $self, type => tolc $type, attr => \%attr);	314	my $txn = "Net::FCP::Txn::$type"->new (fcp => $self, type => tolc $type, attr => \%attr);
249		315
250	$txn;	316	$txn;
251	}	317	}
252		318
253	{ # transactions	319	{ # transactions
…		…
318		384
319	=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])	385	=item $txn = $fcp->txn_generate_chk ($metadata, $data[, $cipher])
320		386
321	=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])	387	=item $uri = $fcp->generate_chk ($metadata, $data[, $cipher])
322		388
323	Calculcates a CHK, given the metadata and data. C<$cipher> is either	389	Calculates a CHK, given the metadata and data. C<$cipher> is either
324	C<Rijndael> or C<Twofish>, with the latter being the default.	390	C<Rijndael> or C<Twofish>, with the latter being the default.
325		391
326	=cut	392	=cut
327		393
328	$txn->(generate_chk => sub {	394	$txn->(generate_chk => sub {
329	my ($self, $metadata, $data, $cipher) = @_;	395	my ($self, $metadata, $data, $cipher) = @_;
330		396
331	$self->txn (generate_chk =>	397	$self->txn (generate_chk =>
332	data => "$metadata$data",	398	data => "$metadata$data",
333	metadata_length => length $metadata,	399	metadata_length => xeh length $metadata,
334	cipher => $cipher \|\| "Twofish");	400	cipher => $cipher \|\| "Twofish");
335	});	401	});
336		402
337	=item $txn = $fcp->txn_generate_svk_pair	403	=item $txn = $fcp->txn_generate_svk_pair
338		404
339	=item ($public, $private) = @{ $fcp->generate_svk_pair }	405	=item ($public, $private) = @{ $fcp->generate_svk_pair }
340		406
341	Creates a new SVK pair. Returns an arrayref.	407	Creates a new SVK pair. Returns an arrayref with the public key, the
		408	private key and a crypto key, which is just additional entropy.
342		409
343	[	410	[
344	"hKs0-WDQA4pVZyMPKNFsK1zapWY",	411	"acLx4dux9fvvABH15Gk6~d3I-yw",
345	"ZnmvMITaTXBMFGl4~jrjuyWxOWg"	412	"cPoDkDMXDGSMM32plaPZDhJDxSs",
		413	"BH7LXCov0w51-y9i~BoB3g",
346	]	414	]
		415
		416	A private key (for inserting) can be constructed like this:
		417
		418	SSK@<private_key>,<crypto_key>/<name>
		419
		420	It can be used to insert data. The corresponding public key looks like this:
		421
		422	SSK@<public_key>PAgM,<crypto_key>/<name>
		423
		424	Watch out for the C<PAgM>-part!
347		425
348	=cut	426	=cut
349		427
350	$txn->(generate_svk_pair => sub {	428	$txn->(generate_svk_pair => sub {
351	my ($self) = @_;	429	my ($self) = @_;
352		430
353	$self->txn ("generate_svk_pair");	431	$self->txn ("generate_svk_pair");
354	});	432	});
355		433
356	=item $txn = $fcp->txn_insert_private_key ($private)	434	=item $txn = $fcp->txn_invert_private_key ($private)
357		435
358	=item $public = $fcp->insert_private_key ($private)	436	=item $public = $fcp->invert_private_key ($private)
359		437
360	Inserts a private key. $private can be either an insert URI (must start	438	Inverts a private key (returns the public key). C<$private> can be either
361	with C<freenet:SSK@>) or a raw private key (i.e. the private value you get	439	an insert URI (must start with C<freenet:SSK@>) or a raw private key (i.e.
362	back from C<generate_svk_pair>).	440	the private value you get back from C<generate_svk_pair>).
363		441
364	Returns the public key.	442	Returns the public key.
365		443
366	UNTESTED.
367
368	=cut	444	=cut
369		445
370	$txn->(insert_private_key => sub {	446	$txn->(invert_private_key => sub {
371	my ($self, $privkey) = @_;	447	my ($self, $privkey) = @_;
372		448
373	$self->txn (invert_private_key => private => $privkey);	449	$self->txn (invert_private_key => private => $privkey);
374	});	450	});
375		451
…		…
377		453
378	=item $length = $fcp->get_size ($uri)	454	=item $length = $fcp->get_size ($uri)
379		455
380	Finds and returns the size (rounded up to the nearest power of two) of the	456	Finds and returns the size (rounded up to the nearest power of two) of the
381	given document.	457	given document.
382
383	UNTESTED.
384		458
385	=cut	459	=cut
386		460
387	$txn->(get_size => sub {	461	$txn->(get_size => sub {
388	my ($self, $uri) = @_;	462	my ($self, $uri) = @_;
…		…
395	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)	469	=item ($metadata, $data) = @{ $fcp->client_get ($uri, $htl, $removelocal)
396		470
397	Fetches a (small, as it should fit into memory) file from	471	Fetches a (small, as it should fit into memory) file from
398	freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or	472	freenet. C<$meta> is the metadata (as returned by C<parse_metadata> or
399	C<undef>).	473	C<undef>).
		474
		475	The C<$uri> should begin with C<freenet:>, but the scheme is currently
		476	added, if missing.
400		477
401	Due to the overhead, a better method to download big files should be used.	478	Due to the overhead, a better method to download big files should be used.
402		479
403	my ($meta, $data) = @{	480	my ($meta, $data) = @{
404	$fcp->client_get (	481	$fcp->client_get (
…		…
409	=cut	486	=cut
410		487
411	$txn->(client_get => sub {	488	$txn->(client_get => sub {
412	my ($self, $uri, $htl, $removelocal) = @_;	489	my ($self, $uri, $htl, $removelocal) = @_;
413		490
		491	$uri =~ s/^freenet://;
		492	$uri = "freenet:$uri";
		493
414	$self->txn (client_get => URI => $uri, hops_to_live => (defined $htl ? $htl :15),	494	$self->txn (client_get => URI => $uri, hops_to_live => xeh (defined $htl ? $htl : 15),
415	remove_local_key => $removelocal ? "true" : "false");	495	remove_local_key => $removelocal ? "true" : "false");
416	});	496	});
417		497
418	=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)	498	=item $txn = $fcp->txn_client_put ($uri, $metadata, $data, $htl, $removelocal)
419		499
420	=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);	500	=item my $uri = $fcp->client_put ($uri, $metadata, $data, $htl, $removelocal);
421		501
422	Insert a new key. If the client is inserting a CHK, the URI may be	502	Insert a new key. If the client is inserting a CHK, the URI may be
423	abbreviated as just CHK@. In this case, the node will calculate the	503	abbreviated as just CHK@. In this case, the node will calculate the
424	CHK.	504	CHK. If the key is a private SSK key, the node will calculcate the public
		505	key and the resulting public URI.
425		506
426	C<$meta> can be a reference or a string (ONLY THE STRING CASE IS IMPLEMENTED!).	507	C<$meta> can be a hash reference (same format as returned by
		508	C<Net::FCP::parse_metadata>) or a string.
427		509
428	THIS INTERFACE IS UNTESTED AND SUBJECT TO CHANGE.	510	The result is an arrayref with the keys C<uri>, C<public_key> and C<private_key>.
429		511
430	=cut	512	=cut
431		513
432	$txn->(client_put => sub {	514	$txn->(client_put => sub {
433	my ($self, $uri, $meta, $data, $htl, $removelocal) = @_;	515	my ($self, $uri, $meta, $data, $htl, $removelocal) = @_;
434		516
435	$self->txn (client_put => URI => $uri, hops_to_live => (defined $htl ? $htl :15),	517	$meta = build_metadata $meta;
		518
		519	$self->txn (client_put => URI => $uri,
		520	hops_to_live => xeh (defined $htl ? $htl : 15),
436	remove_local_key => $removelocal ? "true" : "false",	521	remove_local_key => $removelocal ? "true" : "false",
437	data => "$meta$data", metadata_length => length $meta);	522	data => "$meta$data", metadata_length => xeh length $meta);
438	});	523	});
439		524
440	} # transactions	525	} # transactions
441		526
442	=item MISSING: (ClientPut), InsretKey
443
444	=back	527	=back
445		528
446	=head2 THE Net::FCP::Txn CLASS	529	=head2 THE Net::FCP::Txn CLASS
447		530
448	All requests (or transactions) are executed in a asynchroneous way (LIE:	531	All requests (or transactions) are executed in a asynchronous way. For
449	uploads are blocking). For each request, a C<Net::FCP::Txn> object is	532	each request, a C<Net::FCP::Txn> object is created (worse: a tcp
450	created (worse: a tcp connection is created, too).	533	connection is created, too).
451		534
452	For each request there is actually a different subclass (and it's possible	535	For each request there is actually a different subclass (and it's possible
453	to subclass these, although of course not documented).	536	to subclass these, although of course not documented).
454		537
455	The most interesting method is C<result>.	538	The most interesting method is C<result>.
…		…
672	}	755	}
673	}	756	}
674		757
675	sub progress {	758	sub progress {
676	my ($self, $type, $attr) = @_;	759	my ($self, $type, $attr) = @_;
		760
677	$self->{fcp}->progress ($self, $type, $attr);	761	$self->{fcp}->progress ($self, $type, $attr);
678	}	762	}
679		763
680	=item $result = $txn->result	764	=item $result = $txn->result
681		765
682	Waits until a result is available and then returns it.	766	Waits until a result is available and then returns it.
683		767
684	This waiting is (depending on your event model) not very efficient, as it	768	This waiting is (depending on your event model) not very efficient, as it
685	is done outside the "mainloop".	769	is done outside the "mainloop". The biggest problem, however, is that it's
		770	blocking one thread of execution. Try to use the callback mechanism, if
		771	possible, and call result from within the callback (or after is has been
		772	run), as then no waiting is necessary.
686		773
687	=cut	774	=cut
688		775
689	sub result {	776	sub result {
690	my ($self) = @_;	777	my ($self) = @_;
…		…
730		817
731	use base Net::FCP::Txn;	818	use base Net::FCP::Txn;
732		819
733	sub rcv_success {	820	sub rcv_success {
734	my ($self, $attr) = @_;	821	my ($self, $attr) = @_;
735	$self->set_result ([$attr->{PublicKey}, $attr->{PrivateKey}]);	822	$self->set_result ([$attr->{public_key}, $attr->{private_key}, $attr->{crypto_key}]);
736	}	823	}
737		824
738	package Net::FCP::Txn::InsertPrivateKey;	825	package Net::FCP::Txn::InvertPrivateKey;
739		826
740	use base Net::FCP::Txn;	827	use base Net::FCP::Txn;
741		828
742	sub rcv_success {	829	sub rcv_success {
743	my ($self, $attr) = @_;	830	my ($self, $attr) = @_;
744	$self->set_result ($attr->{PublicKey});	831	$self->set_result ($attr->{public_key});
745	}	832	}
746		833
747	package Net::FCP::Txn::GetSize;	834	package Net::FCP::Txn::GetSize;
748		835
749	use base Net::FCP::Txn;	836	use base Net::FCP::Txn;
750		837
751	sub rcv_success {	838	sub rcv_success {
752	my ($self, $attr) = @_;	839	my ($self, $attr) = @_;
753	$self->set_result ($attr->{Length});	840	$self->set_result (hex $attr->{length});
754	}	841	}
755		842
756	package Net::FCP::Txn::GetPut;	843	package Net::FCP::Txn::GetPut;
757		844
758	# base class for get and put	845	# base class for get and put
759		846
760	use base Net::FCP::Txn;	847	use base Net::FCP::Txn;
761		848
762	*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;	849	*rcv_uri_error = \&Net::FCP::Txn::rcv_throw_exception;
763	*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;	850	*rcv_route_not_found = \&Net::FCP::Txn::rcv_throw_exception;
764		851
765	sub rcv_restarted {	852	sub rcv_restarted {
766	my ($self, $attr, $type) = @_;	853	my ($self, $attr, $type) = @_;
767		854
768	delete $self->{datalength};	855	delete $self->{datalength};
…		…
788	if ($self->{datalength} == length $self->{data}) {	875	if ($self->{datalength} == length $self->{data}) {
789	my $data = delete $self->{data};	876	my $data = delete $self->{data};
790	my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";	877	my $meta = Net::FCP::parse_metadata substr $data, 0, $self->{metalength}, "";
791		878
792	$self->set_result ([$meta, $data]);	879	$self->set_result ([$meta, $data]);
		880	$self->eof;
793	}	881	}
794	}	882	}
795		883
796	sub rcv_data_found {	884	sub rcv_data_found {
797	my ($self, $attr, $type) = @_;	885	my ($self, $attr, $type) = @_;
…		…
835		923
836	package Net::FCP::Exception;	924	package Net::FCP::Exception;
837		925
838	use overload	926	use overload
839	'""' => sub {	927	'""' => sub {
840	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>\n";	928	"Net::FCP::Exception<<$_[0][0]," . (join ":", %{$_[0][1]}) . ">>";
841	};	929	};
842		930
843	=item $exc = new Net::FCP::Exception $type, \%attr	931	=item $exc = new Net::FCP::Exception $type, \%attr
844		932
845	Create a new exception object of the given type (a string like	933	Create a new exception object of the given type (a string like
…		…
900	=cut	988	=cut
901		989
902	package Net::FCP::Event::Auto;	990	package Net::FCP::Event::Auto;
903		991
904	my @models = (	992	my @models = (
905	[Coro => Coro::Event:: ],	993	[Coro => Coro::Event::],
906	[Event => Event::],	994	[Event => Event::],
907	[Glib => Glib:: ],	995	[Glib => Glib::],
908	[Tk => Tk::],	996	[Tk => Tk::],
909	);	997	);
910		998
911	sub AUTOLOAD {	999	sub AUTOLOAD {
912	$AUTOLOAD =~ s/.*://;	1000	$AUTOLOAD =~ s/.*://;

Diff Legend

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

Comparing cvsroot/Net-FCP/FCP.pm (file contents): Revision 1.21 by root, Tue Sep 16 07:00:59 2003 UTC vs. Revision 1.29 by root, Thu May 13 21:43:16 2004 UTC

Diff Legend

Comparing cvsroot/Net-FCP/FCP.pm (file contents):
Revision 1.21 by root, Tue Sep 16 07:00:59 2003 UTC vs.
Revision 1.29 by root, Thu May 13 21:43:16 2004 UTC