User Tools

Site Tools


Differences

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

Link to this comparison view

perl:jrpcd [2020-02-15 00:57] (current)
Line 1: Line 1:
 +=====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===
 +
 +   * {{:​dist:​jrpcd-0.01.tar.gz}}
 +
 +===To install===
 +
 +<​code>​
 +# 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
 +</​code>​
 +
 +===To start===
 +
 +Depend of kind your operation system
 +<​code>​
 +# systemctl start jrpcd
 +</​code>​
 +or 
 +<​code>​
 +# service jrpcd start
 +</​code>​
 +
 +===Request example===
 +<code json>
 +# 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!"​}}
 +</​code>​
 +
 +===Main code===
 +<code perl 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
 +</​code>​
 +
 +----
 +[<>]