User Tools

Site Tools


SOAP to JSON RPC convertor/ JSON RPC application

This small application was planned to use for authentication service about 1200 users on 8 application servers.

I refused this decision because this work will not be paid to me :-\ =) Nevertheless it is good working even in this beta stage. To add functionally, you only need to add your code/methods to aRPC object (see main code below).

I wrote this micro-framework for old (old-old) legacy operating system. I used minimum of third-party modules. And as it turned out, the application works well even on OpenWRT/LEDE Linux with its 24 mb memory =)

Source code package

To install

# tar xzf jrpcd-0.01.tar.gz
# cd jrpcd-0.01
# ./configure --prefix=/usr/local
# make install
# cd /usr/local/etc/jrpcd
# cp jrpcd.crt.example jrpcd.crt
# cp jrpcd.key.example jrpcd.key
# cp jrpcd.pw.example jrpcd.pw

To start

Depend of kind your operation system

# systemctl start jrpcd

or

# service jrpcd start

Request example

# curl -k --data-binary '{"id":1,"jsonrpc":"2.0","method":"hello","params":"John"}' \
    -H 'Content-type: application/json;' https://master:password@app.example.com:4431/rpc
{"jsonrpc":"2.0","id":1,"result":"Hi, John!"}
 
# curl -k --data-binary '{"id":1,"jsonrpc":"2.0","method":"auth","params":["John","password"]}' \
    -H 'Content-type: application/json;' https://master:password@app.example.com:4431/rpc
{"jsonrpc":"2.0","id":1,"result":{"auth":1,"message":""}}
 
# curl -k --data-binary '{"id":1,"jsonrpc":"2.0","method":"auth","params":["John","bad_password"]}' \
    -H 'Content-type: application/json;' https://master:password@app.example.com:4431/rpc
{"jsonrpc":"2.0","id":1,"result":{"auth":0,"message":"Bad password!"}}

Main code

jrpcd.pl.in
#!@perl@
 
#------------
#--- HTTP ---
#------------
 
package aDaemon;
 
use strict;
use warnings;
use threads;
use POSIX qw(strftime getpid setuid setgid geteuid getegid);
use Scalar::Util qw(blessed);
use JSON::PP qw(encode_json decode_json);
use MIME::Base64 qw(decode_base64 encode_base64);
use HTTP::Daemon::SSL;
use HTTP::Status;
 
sub new {
    my ($class, $port, $cert, $key) = @_;
    my $httpd = HTTP::Daemon::SSL->new(
        Reuse => 1,
        SSL_cert_file => $cert,
        SSL_key_file => $key,
        LocalAddr => '0.0.0.0',
        LocalPort => $port,
        Listen => 10,
        SSL_server => 1,
#        SSL_keepSocketOnError => 1,
    );
    my $self = {
        httpd => $httpd,
        route => {},
        config => {
            logfile => '/dev/null',
            pidfile => '/dev/null',
            pwfile => '/dev/null',
            certfile => undef,
            keyfile => undef,
            user => undef,
            group => undef
        }
    };
    bless $self, $class;
    return $self;
}
 
sub httpd {
    my ($self, $httpd) = @_;
    return $self->{httpd} unless $httpd;
    $self->{httpd} = $httpd;
    $self;
}
 
sub config {
    my ($self, $key, $value) = @_;
    return $self->{config} unless $key;
    return $self->{config}->{$key} unless $value;
    $self->{config}->{$key} = $value;
    $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;
    # it's workaround http:// request
    while (1) {
        while (my $c = $self->httpd->accept) {
            # openssl library not thread-safe =( 
            # my $class = blessed $self;
            # threads->create(\&handler, $self, $c)->detach;
            my $pid = fork;
            if ($pid == 0) {
                $self->handler($c);
            }
        }
    }
}
 
sub fork {
    my $self = shift;
 
    my $pid = fork;
    if ($pid > 0) {
        exit;
    }
    chdir("/");
 
    my $user = $self->config('user');
    my $group = $self->config('group');
    my $uid = getpwnam($user) if $user;
    my $gid = getgrnam($group) if $group;
 
    setuid($uid) if $uid;
    setgid($gid) if $gid;
 
    open(my $stdout, '>&', STDOUT); 
    open(my $stderr, '>&', STDERR);
 
    open(STDOUT, '>>', '/dev/null');
    open(STDERR, '>>', '/dev/null');
    getpid;
}
 
sub writepid {
    my $self = shift;
    my $pidfile = $self->config('pidfile');
    return undef unless $pidfile;
    open my $fh, '>', $pidfile or return undef;
    print $fh getpid;
    close $fh;
}
 
sub log {
    my ($self, $message) = @_;
    my $timestamp = strftime("%Y-%m-%d %H:%M:%S %Z", localtime(time));
    print "$timestamp $message\n";
 
    my $logfile = $self->config('logfile');
    open my $fh, '>>', $logfile or return undef;
    print $fh "$timestamp $message\n";
    close $fh;
}
 
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');
 
    ### authorization ###
    my $basic = $req->header('Authorization') || '';
 
    unless ($basic =~ m/Basic /) {
        $self->log("$peer_addr $method $host$uri unauth:undef");
        $c->send_error(RC_UNAUTHORIZED);
        $c->close;
        return;
    };
 
    my ($pair) = $basic =~ m/\w+\s+(\w+)/;
    my ($login, $password) = split(':', decode_base64($pair));
 
    unless ($self->auth($login, $password)) {
        $self->log("$peer_addr $method $host$uri unauth:$login");
        $c->send_error(RC_UNAUTHORIZED);
        $c->close;
        return;
    };
 
    my $content = $req->content;
 
    $self->log("$peer_addr $method $host$uri $login $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->send_basic_header;
        $c->print("Content-Type: application/json");
        $c->send_crlf;
        $c->send_crlf;
        $c->print($res);
    } else {
        $c->send_error(RC_NOT_FOUND);
    }
    $c->close;
    undef($c);
}
 
sub auth {
    my ($self, $name, $password) = @_;
    return undef unless $self->config('pwfile');
    return undef unless $name and $password;
 
    open my $fh, '<', $self->config('pwfile') or return undef;
 
    while (my $line = readline $fh) {
        chomp $line;
        my ($login, $hash, $gecos) = split ':', $line;
        next unless $hash;
        next if $login ne $name;
 
        my ($dummy, $type, $salt, $sum) = split '\$', $hash;
        next unless $salt;
        next unless $sum;
 
        my $new_hash;
        $new_hash = crypt($password, "\$$type\$$salt\$");
        return 1 if $hash eq $new_hash;
    }
    close $fh;
    undef;
}
 
1;
 
#-----------
#--- RPC ---
#-----------
 
package aRPC;
 
use strict;
use warnings;
use JSON::PP qw(encode_json decode_json);
use MIME::Base64 qw(decode_base64 encode_base64);
use Scalar::Util qw(reftype);
 
use SOAP::Lite;
 
sub new {
    my $class = shift;
    my $self = {
    };
    bless $self, $class;
    return $self;
}
 
sub run {
    my ($self, $content) = @_;
 
    my $req;
    eval { $req = decode_json($content); };
    my $err = $@;
    if ($err) {
        my $body = {
            jsonrpc => '2.0',
            error => {
                code => -32700,
                message => 'Parse error',
                data => $@
            },
            id => undef
        };
        return encode_json($body);
    }
 
    my $method = $req->{method};
    my $params = $req->{params};
    my $id = $req->{id};
 
    my $res;
 
    unless (reftype $params) {
        eval { $res = $self->$method($params); };
        $err = $@;
    } elsif (reftype $params eq 'ARRAY') {
        eval { $res =  $self->$method(@{$params}); };
        $err = $@;
    } elsif (reftype $params eq 'HASH') {
        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 => -32601,
                message => 'Method not found',
                data => $@
            },
            id => $id
        };
    }
    encode_json($body);
}
 
sub hello {
    my ($self, $name) = @_;
    $name ||= 'Body';
    "Hi, $name!";
}
 
 
sub list {
    my $res = SOAP::Lite 
        -> uri('http://v8.1c.ru/8.1/data/core')
        -> proxy('http://login:password@app.example.com/ws/Auth')
        -> GetUsersList
        -> result;
    $res->{Value};
}
 
sub auth {
    my ($self, $login, $password) = @_;
 
    my $soap = SOAP::Lite
        ->uri('http://v8.1c.ru/8.1/data/core')
        ->proxy('http://login:password@app.example.com/ws/Auth');
 
    my @params = (
            SOAP::Data->name(UserName => $login)->type('string'),
            SOAP::Data->name(UserPassword => $password)->type('string'),
    );
 
    my $res = $soap->UserAuth(@params)->result;
    my $auth = $res->{Property}->[0]->{Value};
    my $message = $res->{Property}->[1]->{Value};
 
    { auth => $auth, message => $message };
}
 
 
1;
 
use strict;
use warnings;
use Mojo::Util qw(dumper);
use Getopt::Std;
 
my $options = {};
 
getopts("fh", $options);
 
if ($options->{h}) {
    print "Usage: \n";
    print "  -f No fork\n";
    print "  -h Print this help\n";
    exit;
}
 
my $cert = '@app_confdir@/jrpcd.crt';
my $key = '@app_confdir@/jrpcd.key';
 
my $daemon = aDaemon->new(4431, $cert, $key);
 
$daemon->config(pwfile => '@app_confdir@/jrpcd.pw');
$daemon->config(pidfile => '@app_rundir@/jrpcd.pid');
$daemon->config(logfile => '@app_logdir@/jrpcd.log');
$daemon->config(user => '@app_user@');
$daemon->config(group => '@app_group@');
 
$daemon->route('/rpc', aRPC => 'run');
$daemon->log('start application');
$daemon->fork unless $options->{f};
$daemon->writepid;
$daemon->run;
#EOF

First PagePrevious PageBack to overviewNext PageLast Page