Permalink
Browse files

perl port of the python lib!

  • Loading branch information...
1 parent f399af6 commit 36f792f9cfb405fcdb6b0de3920ae8e6696c6f0d @mgregoro mgregoro committed Apr 16, 2012
View
6 contrib/perl/CJDNS/Changes
@@ -0,0 +1,6 @@
+Revision history for Perl extension CJDNS.
+
+0.01 Mon Apr 16 11:47:52 2012
+ - original version; created by h2xs 1.23 with options
+ -AX --skip-exporter --use-new-tests -n CJDNS
+
View
6 contrib/perl/CJDNS/MANIFEST
@@ -0,0 +1,6 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/CJDNS.t
+lib/CJDNS.pm
View
12 contrib/perl/CJDNS/Makefile.PL
@@ -0,0 +1,12 @@
+use 5.014002;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'CJDNS',
+ VERSION_FROM => 'lib/CJDNS.pm', # finds $VERSION
+ PREREQ_PM => {Bencode => 1.4, 'Digest::SHA2' => 1.1}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/CJDNS.pm', # retrieve abstract from module
+ AUTHOR => 'Michael Gregorowicz <mike@mg2.org>') : ()),
+);
View
40 contrib/perl/CJDNS/README
@@ -0,0 +1,40 @@
+CJDNS version 0.01
+==================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2012 by Michael Gregorowicz
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.14.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+
View
212 contrib/perl/CJDNS/lib/CJDNS.pm
@@ -0,0 +1,212 @@
+package CJDNS;
+
+use Bencode qw(bencode bdecode);
+use Carp qw/croak/;
+use Digest::SHA2;
+use IO::Socket;
+
+# buffer size for reading from teh sawkets.
+use constant BUFFER_SIZE => 1024;
+
+our @ISA = qw();
+our $VERSION = '0.01';
+our $sha2 = new Digest::SHA2 256;
+
+# turn on autoflush for this class.
+our $| = 1;
+
+sub new {
+ my ($class, $addr, $port, $password) = @_;
+
+ my $self = bless({
+ connection => "$addr:$port",
+ password => $password,
+ }, $class);
+
+ $self->{s} = IO::Socket::INET->new(
+ PeerAddr => $addr,
+ PeerPort => $port,
+ Proto => 'tcp',
+ Type => SOCK_STREAM
+ );
+
+ unless ($self->_ping) {
+ die "Error, cannot ping CJDNS admin service on $self->{connection}\n";
+ }
+
+ $self->_make_methods;
+
+ return $self;
+}
+
+sub _make_methods {
+ my ($self) = @_;
+ my $s = $self->s;
+
+ my ($to_decode);
+ print $s "d1:q7:invalide";
+ while (1) {
+ my $data;
+ recv($s, $data, BUFFER_SIZE, undef);
+ if (length($data)) {
+ $to_decode .= $data;
+ if (length($data) < BUFFER_SIZE) {
+ last;
+ }
+ }
+ }
+
+ my $decoded = bdecode($to_decode);
+
+ # first let's start by loading them as named into the CJDNS namespace.
+
+ foreach my $method_name (keys %{$decoded->{availableFunctions}}) {
+ my $prototype = $decoded->{availableFunctions}->{$method_name};
+ $self->{capabilities}->{$method_name} = $prototype;
+
+ # This is the code that actually calls the function!
+ my $method = sub {
+ my ($self, %args) = @_;
+ my $s = $self->s;
+ my ($to_decode);
+ print $s "d1:q6:cookiee";
+ while (1) {
+ my $data;
+ recv($s, $data, BUFFER_SIZE, undef);
+ if (length($data)) {
+ $to_decode .= $data;
+ if (length($data) < BUFFER_SIZE) {
+ last;
+ }
+ }
+ }
+
+ my $dec = bdecode($to_decode);
+
+ my $cookie = $dec->{cookie};
+
+ my $req = {
+ q => 'auth',
+ aq => $method_name,
+ hash => $self->_sha2_hexdigest($self->{password} . $cookie),
+ cookie => " $cookie",
+ args => \%args,
+ };
+
+ # replace $req->{hash} with a hash of the bencoded request.
+ my $req_benc = bencode($req);
+ $req->{hash} = $self->_sha2_hexdigest($req_benc);
+
+ # then re-encode thusly:
+ $req_benc = bencode($req);
+
+ print $s $req_benc;
+
+ my ($to_decode);
+ while (1) {
+ my $data;
+ recv($s, $data, BUFFER_SIZE, undef);
+ if (length($data)) {
+ $to_decode .= $data;
+ if (length($data) < BUFFER_SIZE) {
+ last;
+ }
+ }
+ }
+ my $dec = bdecode($to_decode);
+ if (ref($dec)) {
+ if ($dec->{error}) {
+ croak "[error] CJDNS method '$method_name': $dec->{error}";
+ }
+ }
+ return $dec;
+ };
+
+ # and now it's a method!
+ my $full_name = "CJDNS::$method_name";
+ *{$full_name} = $method;
+ }
+}
+
+sub capabilities {
+ my ($self) = @_;
+ my $return = "CJDNS Administration Protocol Capabilities\n";
+ $return .= "------------------------------------------\n";
+ foreach my $func (keys %{$self->{capabilities}}) {
+ $return .= " $func\n";
+ foreach my $attr (keys %{$self->{capabilities}->{$func}}) {
+ $return .= " + $attr: $self->{capabilities}->{$func}->{$attr}->{type} ";
+
+ if ($self->{capabilities}->{$func}->{$attr}->{required}) {
+ $return .= "[required]";
+ }
+
+ $return .= "\n";
+ }
+ $return .= "\n";
+ }
+ return $return;
+}
+
+sub _sha2_hexdigest {
+ my ($self, $string) = @_;
+ $sha2->reset();
+ $sha2->add($string);
+ return $sha2->hexdigest;
+}
+
+sub _ping {
+ my ($self) = @_;
+ my $s = $self->s;
+
+ my $data;
+ print $s "d1:q4:pinge";
+ recv($s, $data, BUFFER_SIZE, undef);
+
+ if ($data eq "d1:q4:ponge") {
+ return 1;
+ } else {
+ return undef;
+ }
+}
+
+sub s {
+ my ($self) = @_;
+ return $self->{s};
+}
+
+# Preloaded methods go here.
+
+1;
+__END__
+
+=head1 NAME
+
+CJDNS - Perl interface to the CJDNS Administration Interface
+
+=head1 SYNOPSIS
+
+ use CJDNS;
+ blah blah blah
+
+=head1 DESCRIPTION
+
+Perl interface to the CJDNS Administration system
+
+=head1 SEE ALSO
+
+https://github.com/cjdelisle/cjdns
+
+=head1 AUTHOR
+
+Michael Gregorowicz, E<lt>mikei@mg2.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2012 by Michael Gregorowicz
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.14.2 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
View
18 contrib/perl/CJDNS/t/CJDNS.t
@@ -0,0 +1,18 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl CJDNS.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+BEGIN { use_ok('CJDNS') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+

0 comments on commit 36f792f

Please sign in to comment.