User Tools

Site Tools


Differences

This shows you the differences between two versions of the page.

Link to this comparison view

perl:nano-jrpc [2020-02-15 00:57] (current)
Line 1: Line 1:
 +=====Nano framework: JSON RPC server====
 +
 +I wrote it for small embedded automation. It use only stable and wide shared HTTP::​Daemon and threads.
 +
 +The example I publish without demonize code, config reader and other optional code for easy view.
 +
 +Full small work application you can look there [[perl/​jrpcd]]
 +
 +
 +   * JSON-RPC 2.0 Specification [[http://​www.jsonrpc.org/​specification]]
 +
 +<code perl httpd.pl>​
 +#​!/​usr/​bin/​env perl
 +
 +package aHTTP;
 +
 +use strict;
 +use warnings;
 +use threads;
 +use Scalar::​Util qw(blessed);​
 +use MIME::​Base64 qw(decode_base64 encode_base64);​
 +use HTTP::​Daemon;​
 +use HTTP::​Status;​
 +
 +sub new {
 +    my ($class, $port) = @_;
 +    my $daemon = HTTP::​Daemon->​new(
 +        LocalPort => $port,
 +        Reuse => 1
 +    );
 +    my %route;
 +    my $self = {
 +        daemon => $daemon,
 +        port => $port,
 +        route => \%route,
 +    };
 +    bless $self, $class;
 +    return $self;
 +}
 +
 +sub daemon {
 +    my ($self, $daemon) = @_;
 +    return $self->​{daemon} unless $daemon;
 +    $self->​{daemon} = $daemon;
 +    $self;
 +}
 +
 +sub route {
 +    my ($self, $route, $class, $method) = @_;
 +    unless ($class and $method) {
 +        return $self->​{routes}->​{$route};​
 +    }
 +    $self->​{routes}->​{$route}->​{class} = $class;
 +    $self->​{routes}->​{$route}->​{method} = $method;
 +    $self;
 +}
 +
 +sub run {
 +    my $self = shift;
 +    while (my $c = $self->​daemon->​accept) {
 +        my $class = blessed $self;
 +        threads->​create(\&​handler,​ $self, $c)->​detach;​
 +    }
 +}
 +
 +sub log {
 +    my ($self, $message) = @_;
 +    print $message, "​\n";​
 +}
 +
 +sub handler {
 +    my ($self, $c) = @_;
 +    my $req = $c->​get_request;​
 +
 +    #### logger ####
 +    my $peer_addr = $c->​peerhost;​
 +    my $uri = $req->​uri;​
 +    my $method = $req->​method;​
 +    my $host = $req->​header('​Host'​);​
 +    my $content = $req->​content;​
 +
 +    $self->​log("​$peer_addr $method $host$uri $content"​);​
 +
 +    #### router ####
 +    my $path = $req->​uri->​path;​
 +
 +    my $p = $self->​route($path);​
 +    my $class = $p->​{class};​
 +    my $subr = $p->​{method};​
 +
 +    if ($class and $subr) {
 +
 +        my $obj = $class->​new;​
 +        my $res = $obj->​$subr($content);​
 +
 +        $c->​print("​Content-Type:​ application/​json"​);​
 +        $c->​send_crlf;​
 +        $c->​send_crlf;​
 +        $c->​print($res);​
 +    } else {
 +        $c->​send_error(RC_FORBIDDEN);​
 +    }
 +    $c->​close;​
 +    undef($c);
 +}
 +
 +1;
 +
 +package aRPC;
 +
 +use strict;
 +use warnings;
 +use JSON::PP qw(encode_json decode_json);​
 +use Scalar::​Util qw(reftype);​
 +
 +sub new {
 +    my $class = shift;
 +    my $self = {
 +    };
 +    bless $self, $class;
 +    return $self;
 +}
 +
 +sub run {
 +    my ($self, $content) = @_;
 +    my $req = decode_json($content);​
 +
 +    my $method = $req->​{method};​
 +    my $params = $req->​{params};​
 +    my $id = $req->​{id};​
 +
 +    my $res;
 +    my $err;
 +
 +    unless (reftype $params) {
 +        eval { $res = $self->​$method($params);​ };
 +        $err = $@;
 +    } elsif (reftype $params eq '​ARRAY'​) {
 +        my @params = @{$params};
 +        eval { $res =  $self->​$method(@params);​ };
 +        $err = $@;
 +    } elsif (reftype $params eq '​HASH'​) {
 +        my %params = %{$params};
 +        eval { $res =  $self->​$method(%params);​ };
 +        $err = $@;
 +    };
 +    my $body;
 +    unless ($err) {
 +        $body = {
 +            jsonrpc => "​2.0",​
 +            result => $res,
 +            id => $id
 +        };
 +    } else {
 +        $body = {
 +            jsonrpc => "​2.0",​
 +            error => {
 +                code => 1,
 +                message => "​Generic error: $@",
 +            },
 +            id => $id
 +        }
 +    }
 +    encode_json($body);​
 +}
 +
 +sub hello {
 +    my ($self, $name) = @_;
 +    return undef unless $name;
 +    "Hi, $name!";​
 +}
 +
 +1;
 +
 +use strict;
 +use warnings;
 +
 +my $d = aHTTP->​new(8081);​
 +$d->​route('/​rpc',​ aRPC => '​run'​);​
 +$d->run;
 +#EOF
 +</​code>​
 +
 +
 +===Server side===
 +
 +<​code>​
 +# ./httpd.pl
 +127.0.0.1 POST 127.0.0.1:​8081/​rpc {"​id":​1,"​jsonrpc":"​2.0","​method":"​hello","​params":"​John"​}
 +</​code>​
 +
 +===Client side===
 +<​code>​
 +# curl -v --data-binary '​{"​id":​1,"​jsonrpc":"​2.0","​method":"​hello","​params":"​John"​}' ​ \
 +          -H '​content-type:​ text/​json;'​ http://​127.0.0.1:​8081/​rpc
 +*   ​Trying 127.0.0.1...
 +* Connected to 127.0.0.1 (127.0.0.1) port 8081 (#0)
 +> POST /rpc HTTP/1.1
 +> Host: 127.0.0.1:​8081
 +> User-Agent: curl/7.48.0
 +> Accept: */*
 +> content-type:​ text/json;
 +> Content-Length:​ 57
 +
 +* upload completely sent off: 57 out of 57 bytes
 +Content-Type:​ text/json
 +
 +{"​result":"​Hi,​ John!","​id":​1,"​jsonrpc":"​2.0"​}
 +</​code>​
 +
 +
 +----
 +[<>]
 +